diff --git a/BUILD.md b/BUILD.md index b13e14c8a..3b16c8eea 100644 --- a/BUILD.md +++ b/BUILD.md @@ -1,5 +1,5 @@ -# STEPS TO COMPILE LIBFLAME USING CMAKE -## 1. Generating Libflame library +# STEPS TO COMPILE AOCL-LAPACK USING CMAKE +## 1. Generating AOCL-LAPACK library Create a new build directory e.g. build1 mkdir build1; cd build1; @@ -31,37 +31,78 @@ Shared library is turned on by default. To generate Static library provide additional option -DBUILD_SHARED_LIBS=OFF - compile library using following command. This will generate libflame.a/libflame.so library in the lib directory + Compile library using following command. This will generate libflame.a/libflame.so library in the lib directory cmake --build . -j OR make -j + Install the library + make install + +Linking with AOCL-BLAS +------------------------------------ +AOCL-LAPACK can be linked with any Netlib BLAS compliant library when compiled with standard cmake options above. However, AOCL-LAPACK provides an option to explicitly to link with AOCL-BLAS library at compile time. This option helps achieve better performance for certain APIs on AMD "Zen" CPUs by invoking lower level AOCL-BLAS APIs directly. To force AOCL-LAPACK to use AOCL-BLAS library, provide option ENABLE_AOCL_BLAS in cmake configuration + +$ cmake -DENABLE_AMD_AOCC_FLAGS=ON -DENABLE_AOCL_BLAS=ON ... + +The path of AOCL-BLAS library can be provided in one of the following methods +1. Set "AOCL_ROOT" environment variable to the root path where AOCL-BLAS library($AOCL_ROOT/lib) and header files($AOCL_ROOT/include) are located. +$ export AOCL_ROOT= + +2. Specify root path of AOCL-BLAS library through cmake option "AOCL_ROOT" +$ cmake -DENABLE_AMD_AOCC_FLAGS=ON -DENABLE_AOCL_BLAS=ON -DAOCL_ROOT= ... + +The path specified in AOCL_ROOT must have "include" directory and a "lib" directory that contains the necesaary header files and AOCL-BLAS binary respectively. + Linking with AOCL Utilities library ------------------------------------ -libflame requires AOCL Utilities library "libaoclutils" for certain functions including CPU architecture detection at runtime. The libflame CMake build system, by default, automatically links with libaoclutils library by downloading the source of libaoclutils from AMD GitHub, compiling it and linking/merging with libflame library. However, user can provide an external path for libaoclutils binary and header files via separate flags, 'LIBAOCLUTILS_LIBRARY_PATH' and 'LIBAOCLUTILS_INCLUDE_PATH' respectively. In this scenario, CMake will use the user provided library and does not download libaoclutils source. Following is a sample command for the same +AOCL-LAPACK depends on AOCL Utilities library, AOCL-Utils for certain functions including CPU architecture detection at runtime. The default build of AOCL-LAPACK requires path to AOCL-Utils header files to be set as follows + +- For CMake based build, ensure header file path of AOCL-Utils is set using LIBAOCLUTILS_INCLUDE_PATH option. + $ cmake ../ -DENABLE_AMD_FLAGS=ON -DLIBAOCLUTILS_INCLUDE_PATH= + +- For autoconfigure makefile based build, ensure header file path of AOCL-Utils is set in CFLAGS before running make command. + $ export CFLAGS="-I" + $ configure --enable-amd-flags + $ make -j + +In the default build mode, applications using AOCL-LAPACK must link with AOCL-Utils explicitly. -$ cmake ../ -DENABLE_AMD_FLAGS=ON -DCMAKE_INSTALL_PREFIX= -DLIBAOCLUTILS_LIBRARY_PATH= -DLIBAOCLUTILS_INCLUDE_PATH= +User has an option to merge the AOCL-Utils library with AOCL-LAPACK library. This can be done using "ENABLE_EMBED_AOCLUTILS" option for both CMake and autoconfigure tools build mode. With this option, AOCL-LAPACK can automatically link with libaoclutils library by downloading the source of libaoclutils from AMD GitHub, compiling it and linking/merging with AOCL-LAPACK library. Following is sample command +CMake Build: $ cmake ../ -DENABLE_AMD_FLAGS=ON -DENABLE_EMBED_AOCLUTILS=ON +Autoconfigure : $ configure --enable-amd-flags + $ make ENABLE_EMBED_AOCLUTILS=1 -j + +With embed AOCL-Utils build, if user provides an external path for libaoclutils binary and header files via separate flags, 'LIBAOCLUTILS_LIBRARY_PATH' and 'LIBAOCLUTILS_INCLUDE_PATH' respectively, user provided library is used instead of downloading from GitHub. Following is a sample command for the same +CMake Build: $ cmake ../ -DENABLE_AMD_FLAGS=ON -DENABLE_EMBED_AOCLUTILS=ON DLIBAOCLUTILS_LIBRARY_PATH= -DLIBAOCLUTILS_INCLUDE_PATH= +Autoconfigure : $ configure --enable-amd-flags + $ make ENABLE_EMBED_AOCLUTILS=1 LIBAOCLUTILS_LIBRARY_PATH= LIBAOCLUTILS_INCLUDE_PATH= -j ## 2. Building main Test and AOCL_FLA_PROGRESS Test Suite - In order to build tests an an additional flag can be set to ON - -DBUILD_TEST=ON -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH=/path/to/blas/library -DEXT_BLAS_LIBNAME=blas_lib_name - -DBLAS_HEADER_PATH="" +In order to build tests an additional flag, BUILD_TEST, must be set ON + -DBUILD_TEST=ON -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH="" -DEXT_BLAS_LIBNAME=blas_lib_name + -DBLAS_HEADER_PATH="" + -DLIBAOCLUTILS_LIBRARY_PATH="" - This will enable aocl progress feature tests, main test suite. It will generate test_libFLAME_aocl , test_lapack.x executables in the respective directories. - Note: Building tests require path to an external blas library. Refer to Readme in respective test suite directory for more details - Recomended to use blis sharedlib with libflame sharedlib +This will enable aocl progress feature tests and main test suite. It will generate test_libFLAME_aocl , test_lapack.x executables in the respective directories. +Note: Building tests require path to AOCL-Utils library and an external blas library. Refer to Readme in respective test suite directory for more details +Recomended to use AOCL-BLAS sharedlib with AOCL-LAPACK sharedlib + +## 3 Building Legacy test and Netlib test + # 1. To build Legacy test suite use + -DBUILD_LEGACY_TEST=ON -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH=<"path to blas library" -DEXT_BLAS_LIBNAME=blas_lib_name + -DBLAS_HEADER_PATH="" + -DLIBAOCLUTILS_LIBRARY_PATH="" -## 3 Building Legacy test - To build Legacy test suite use - -DBUILD_LEGACY_TEST=ON -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH=/path/to/blas/library -DEXT_BLAS_LIBNAME=blas_lib_name - -DBLAS_HEADER_PATH="" - Note: On Windows, to build and run legacy test suite, a separate macro flag is enabled during libflame library build because of certain constraints in legacy test suite. + Note: On Windows, to build and run legacy test suite, a separate macro flag is enabled during AOCL-LAPACK library build because of certain constraints in legacy test suite. + # 2. To Build Netlib-test add -DBUILD_NETLIB_TEST=ON along with cmake commands. + note: Windows requires running create_new_testdir.bat script before running netlib test ## 4. ENABLE TRACE and LOGS User may also enable trace and logs by passing -DENABLE_AOCL_DTL=[OPTION] along with setting the value of Macros AOCL_DTL_TRACE_ENABLE and AOCL_DTL_LOG_ENABLE to 1 in file libflame/src/aocl_dtl/aocldtlcf.h e.g. - cmake ../ -DENABLE_ILP64=OFF -DENABLE_AMD_FLAGS=ON -DBUILD_TEST=ON -DENABLE_AOCL_DTL=[DTL_OPTION] -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH=path/to/blas/lib -DEXT_BLAS_LIBNAME= -DCMAKE_INSTALL_PREFIX= -DBLAS_HEADER_PATH="" + cmake ../ -DENABLE_ILP64=OFF -DENABLE_AMD_FLAGS=ON -DBUILD_TEST=ON -DENABLE_AOCL_DTL=[DTL_OPTION] -DCMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH="" -DEXT_BLAS_LIBNAME= -DCMAKE_INSTALL_PREFIX= -DBLAS_HEADER_PATH="" -DLIBAOCLUTILS_LIBRARY_PATH="" DTL_OPTION 1. "ALL" to ENABLE TRACE and LOG @@ -72,13 +113,41 @@ $ cmake ../ -DENABLE_AMD_FLAGS=ON -DCMAKE_INSTALL_PREFIX= -DLIBAOCLUTILS_L ## 5. Using an external Lapack library to run tests In order to run tests on an external lapack library an additional option -DEXT_LAPACK_LIBRARY_PATH="path/to/external/lapack/library" and -DEXT_LAPACK_LIBNAME="NAME_OF_THE_LAPACK_LIB" can be passed. - if the above options are left blank libflame library will be used + if the above options are left blank AOCL-LAPACK library will be used ## 6. Linking with an external openmp library In Order to link with an external openmp library user can pass -DEXT_OPENMP_PATH= -DEXT_OPENMP_LIB= - Note: In order to use openmp from the system -DEXT_OPENMP_PATH is to be left blank + Note: 1. In order to use openmp from the system -DEXT_OPENMP_PATH is to be left blank + 2. To link Intel OpenMP library,libiomp5.so, set following flag addtionally + gcc + -DCMAKE_C_FLAG="-fopenmp" + aocc + -DCMAKE_C_FLAG="-fopenmp=libiomp5" + +## 7. Using ctest + Ctest is enabled when -DBUILD_TEST=ON OR -DBUILD_LEGACY_TEST=ON OR -DBUILD_NETLIB_TEST=ON + To run ALL ctests together following command can be given. + ctest --test-dir [BUILD_DIR] + To run a specific ctest following command can be given. + ctest -R [TEST_NAME] + Note: Test names can be listed by + ctest -N + To run build from any location + ctest --test-dir [BUILD_DIR] + Additionally --verbose can be added to print the output from the executable. + Example: + Following command can be used to run tests with regular expression neg_test + ctest --test-dir -R neg_test --verbose + on windows additional "-C Release" is needed to run the test + ctest --test-dir -R neg_test -C Release --verbose + To list all the tests ctest --test-dir [BUILD_DIR] -N can be given +## 8. ENABLE GCOV + In order to enable code coverage -DENABLE_GCOV can be passed during configuration. + After running the executable in the root directory run + bash generate_code_coverage_html.sh. + It will give you a prompt to view the code coverage of that particular application. diff --git a/CMakeLists.txt b/CMakeLists.txt index ccec416dc..e97c4cac3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,6 @@ ##Copyright (C) 2023, Advanced Micro Devices, Inc.## -cmake_minimum_required(VERSION 3.11) +cmake_minimum_required(VERSION 3.15.0) if(WIN32) project(AOCL-LibFLAME-Win) @@ -20,6 +20,7 @@ endif() message(STATUS "External blas library Path : ${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH}") message(STATUS "External blas library name : ${EXT_BLAS_LIBNAME}") +SET(LF_ISA_CONFIG "AVX2" CACHE STRING "LibFlame Instruction set architecture Configuration") #gccopenmp if(WIN32) @@ -29,6 +30,7 @@ endif() message(STATUS "CMAKE_C_COMPILER_ID: ${CMAKE_C_COMPILER_ID}") message(STATUS "C compiler version: ${CMAKE_C_COMPILER_VERSION}") + #set the output directory path for windows and Linux set (CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_SOURCE_DIR}/lib") set (CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_SOURCE_DIR}/lib") @@ -36,6 +38,38 @@ set (CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_SOURCE_DIR}/bin") # Added for debugging purpose set(CMAKE_VERBOSE_MAKEFILE OFF) +if(WIN32) + set (PYTHON_EXE "python") +else() + set (PYTHON_EXE "python3") +endif() +### Making LF_ISA_CONFIG case insensitive ### +string(TOLOWER "${LF_ISA_CONFIG}" lf_isa_config_lower) + +if ("${lf_isa_config_lower}" STREQUAL "none" OR "${lf_isa_config_lower}" STREQUAL "avx" OR "${lf_isa_config_lower}" STREQUAL "avx2" OR "${lf_isa_config_lower}" STREQUAL "avx512" OR "${lf_isa_config_lower}" STREQUAL "auto") + message("Machine ISA configuration set to ${LF_ISA_CONFIG}") +else() + message(FATAL_ERROR "Machine ISA configuration error, valid values are AVX, AVX2, AVX512 and auto") +endif() + +if (${lf_isa_config_lower} STREQUAL "auto") + set(AUTO_CONFIG_PY "${CMAKE_SOURCE_DIR}/build/auto_config.py") + # Run python script to find the architecture family name + execute_process( + COMMAND ${PYTHON_EXE} ${AUTO_CONFIG_PY} + RESULT_VARIABLE CMD_RESULT + OUTPUT_VARIABLE CMD_OUTPUT + OUTPUT_STRIP_TRAILING_WHITESPACE) + message( STATUS "Auto configuring the family :" ${CMD_OUTPUT}) + if(${CMD_OUTPUT} STREQUAL "zen" OR ${CMD_OUTPUT} STREQUAL "zen2" OR ${CMD_OUTPUT} STREQUAL "zen3") + set(lf_isa_config_lower "avx2") + elseif(${CMD_OUTPUT} STREQUAL "zen4") + set(lf_isa_config_lower "avx512") + else() + set(lf_isa_config_lower "none") + endif() +endif () +message("LF_ISA_CONFIG selected:${LF_ISA_CONFIG}") #set AOCL Utilities library path values set(LIBAOCLUTILS_PROJECT "libaoclutils") set(LIBAOCLUTILS_INSTALL_DIR_NAME "install-aoclutils") @@ -61,6 +95,7 @@ option (ENABLE_AMD_AOCC_FLAGS "Enable AMD FLAGS internally enables Enable AMD FL if(WIN32) mark_as_advanced(ENABLE_AMD_AOCC_FLAGS) endif() +option (ENABLE_AOCL_BLAS "Enables tight coupling with AOCL-BLAS library in order to use AOCL-BLAS internal routines" OFF) option (ENABLE_ILP64 "Enable ILP64" OFF) option (ENABLE_UPPERCASE "Enable uppercase API's" OFF) option (ENABLE_WRAPPER "Enable wrapper code" ON) @@ -104,44 +139,64 @@ option (ENABLE_SET_LIB_VERSION "Set library version" OFF) option (ENABLE_BLAS_EXT_GEMMT "Enable BLAS GEMMT Usage" ON) set(ENABLE_AOCL_DTL OFF CACHE STRING "Enable DTL Usage. USE with Option ALL to Enable both Trace and Log, TRACE to enable Trace, and LOG to ENABLE only Input Logging ") set_property(CACHE ENABLE_AOCL_DTL PROPERTY STRINGS TRACE_AND_LOG TRACE LOG OFF ) +option (ENABLE_EMBED_AOCLUTILS "Enables embedding aocl-utils library in AOCL-LAPACK" OFF) message(STATUS "CMAKE_BUILD_TYPE : ${CMAKE_BUILD_TYPE}") if(WIN32) - set (ENABLE_WINDOWS_BUILD "Enables windows build " ON) - message(STATUS "ENABLE_WINDOWS_BUILD : ${ENABLE_WINDOWS_BUILD}") + set (ENABLE_WINDOWS_BUILD "Enables windows build " ON) + message(STATUS "ENABLE_WINDOWS_BUILD : ${ENABLE_WINDOWS_BUILD}") + cmake_policy(SET CMP0091 NEW) + if(BUILD_SHARED_LIBS) + set(CMAKE_MSVC_RUNTIME_LIBRARY "MultiThreaded$<$:Debug>DLL") + else() + set(CMAKE_MSVC_RUNTIME_LIBRARY "MultiThreaded$<$:Debug>") + endif() +endif() +set(AOCL_ROOT "" CACHE STRING "AOCL-BLAS installation path") + +if (ENABLE_AOCL_BLAS) + message(STATUS "AOCL-BLAS library linking option selected") + include(cmake/find_aocl-blas.cmake) endif() -SET(ENABLE_SIMD_FLAGS "AVX2" CACHE STRING "Set compiler SIMD flags") -SET_PROPERTY(CACHE ENABLE_SIMD_FLAGS PROPERTY STRINGS none SSE2 AVX AVX2) message(STATUS "checking SIMD ") if(WIN32) - message(STATUS "checking SIMD Windows : ${ENABLE_SIMD_FLAGS}") - if(${ENABLE_SIMD_FLAGS} MATCHES "AVX2") + if(${lf_isa_config_lower} STREQUAL "avx512") + add_definitions(/arch:AVX512) + elseif(${lf_isa_config_lower} STREQUAL "avx2" OR ${lf_isa_config_lower} STREQUAL "avx") add_definitions(/arch:AVX2) - elseif(${ENABLE_SIMD_FLAGS} MATCHES "AVX") - add_definitions(/arch:AVX) - elseif(${ENABLE_SIMD_FLAGS} MATCHES "SSE2") - add_definitions(/arch:SSE2) + else() + message(STATUS "No ISA flag set") endif() elseif(UNIX) - message(STATUS "checking SIMD on linux : ${ENABLE_SIMD_FLAGS}") set(COMPILER_OPTIMIZATION_FLAGS "-mtune=native -O3") - - if(${ENABLE_SIMD_FLAGS} MATCHES "AVX2") + if(${lf_isa_config_lower} STREQUAL "avx512") + set(COMPILER_OPTIMIZATION_FLAGS "${COMPILER_OPTIMIZATION_FLAGS} -mavx512f -mfma") + elseif(${lf_isa_config_lower} STREQUAL "avx2" OR ${lf_isa_config_lower} STREQUAL "avx") set(COMPILER_OPTIMIZATION_FLAGS "${COMPILER_OPTIMIZATION_FLAGS} -mavx2 -mfma") + else() + message(STATUS "No ISA flag set") endif() set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${COMPILER_OPTIMIZATION_FLAGS}") else() message(STATUS "OS UNKNOWN CANNOT SET SIMD") endif() +if(ENABLE_GCOV) + set(CMAKE_CXX_OUTPUT_EXTENSION_REPLACE ON) + add_definitions(--coverage) + set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} --coverage") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fprofile-arcs -ftest-coverage") +endif() + #Adding PIC flag and other flags if(UNIX) SET(COMPILER_DEBUG_FLAG "-g0") set(GCC_WARNING_FLAGS "-Wall -Wno-comment") - set(COMPILER_LANGUAGE_FLAGS "-std=gnu99 -Wno-unused-function -Wno-parentheses -Wfatal-errors ") + set(COMPILER_LANGUAGE_FLAGS " -std=c11 -D_GNU_SOURCE -Wno-unused-function -Wno-parentheses -Wfatal-errors ") set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${COMPILER_DEBUG_FLAG} ${GCC_WARNING_FLAGS} ${COMPILER_LANGUAGE_FLAGS}") + add_compile_options(-fPIC) endif() #Temporary hack for Clang. Enable -Wno-error=implicit-function-declaration @@ -150,36 +205,6 @@ if (CMAKE_CXX_COMPILER_ID STREQUAL "Clang") set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -Wno-error=implicit-function-declaration -Wno-error=incompatible-function-pointer-types") endif () -if(WIN32) - set_source_files_properties( -src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c -src/lapack/x86/avx2/fla_dgetrf_avx2.c -src/lapack/x86/avx2/fla_dhrot3_avx2.c -src/lapack/x86/avx2/fla_drot_avx2.c -src/lapack/x86/avx2/fla_dscal_ix1_avx2.c -src/lapack/x86/avx2/fla_sger_avx2.c -src/lapack/x86/avx2/fla_sscal_ix1_avx2.c -src/lapack/x86/avx2/fla_zscal_ix1_avx2.c -src/lapack/x86/avx2/fla_zgetrf_avx2.c -src/lapack/x86/avx2/fla_zrot_avx2.c - PROPERTIES COMPILE_OPTIONS "/arch:AVX2" - ) -else() - set_source_files_properties( -src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c -src/lapack/x86/avx2/fla_dgetrf_avx2.c -src/lapack/x86/avx2/fla_dhrot3_avx2.c -src/lapack/x86/avx2/fla_drot_avx2.c -src/lapack/x86/avx2/fla_dscal_ix1_avx2.c -src/lapack/x86/avx2/fla_sger_avx2.c -src/lapack/x86/avx2/fla_sscal_ix1_avx2.c -src/lapack/x86/avx2/fla_zscal_ix1_avx2.c -src/lapack/x86/avx2/fla_zgetrf_avx2.c -src/lapack/x86/avx2/fla_zrot_avx2.c - PROPERTIES COMPILE_OPTIONS "-mtune=native;-O3;-mavx2;-mfma" - ) -endif () - # Adding missing Macros if(UNIX) set(FLA_PORTABLE_TIMER_IS_CLOCK_GETTIME TRUE) @@ -271,7 +296,6 @@ message(STATUS "Enabled ENABLE_F2C_DOTC : ${ENABLE_F2C_DOTC} ") message(STATUS "Enabled ENABLE_VOID_RETURN_COMPLEX_FUNCTION : ${ENABLE_VOID_RETURN_COMPLEX_FUNCTION} ") message(STATUS "Enabled ENABLE_MULTITHREADING : ${ENABLE_MULTITHREADING} ") message(STATUS "Enabled MULTITHREADING_MODEL : ${MULTITHREADING_MODEL} ") -message(STATUS "CMAKE_INSTALL_PREFIX : ${CMAKE_INSTALL_PREFIX}") if(ENABLE_MULTITHREADING) set (ENABLE_OPENMP TRUE) @@ -372,12 +396,12 @@ if (ENABLE_MULTITHREADING) endif () if (ENABLE_OPENMP) + set (MULTITHREADING_MODEL 1) + set (FLA_MULTITHREADING_MODEL TRUE) + add_definitions(-DFLA_MULTITHREADING_MODEL) if(NOT EXT_OPENMP_PATH) find_package(OpenMP) if (OPENMP_FOUND) - set (MULTITHREADING_MODEL 1) - set (FLA_MULTITHREADING_MODEL TRUE) - add_definitions(-DFLA_MULTITHREADING_MODEL) set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${OpenMP_C_FLAGS}") set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${OpenMP_CXX_FLAGS}") set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} ${OpenMP_EXE_LINKER_FLAGS}") @@ -449,7 +473,10 @@ if(BUILD_LEGACY_TEST) endif() endif() +if (NOT ENABLE_AOCL_BLAS) add_definitions(-DBLIS1_FROM_LIBFLAME) +endif() + add_definitions(-DLAPACK_COMPLEX_STRUCTURE) if(WIN32) @@ -769,9 +796,6 @@ string (APPEND MK_HEADER_DIR_PATHS " ${CMAKE_SOURCE_DIR}/src/lapack/util/app/qutinc/front/flamec/" " ${CMAKE_SOURCE_DIR}/src/lapack/util/app/qutinc/lhfc/flamec/" " ${CMAKE_SOURCE_DIR}/src/lapack/util/app/qutinc/lnfc/flamec/" - " ${CMAKE_SOURCE_DIR}/src/lapack/x86/" - " ${CMAKE_SOURCE_DIR}/src/lapack/x86/avx2" - " ${CMAKE_SOURCE_DIR}/src/lapack/x86/front" " ${CMAKE_SOURCE_DIR}/src/lapacke/LAPACKE/example/" " ${CMAKE_SOURCE_DIR}/src/lapacke/LAPACKE/include/" " ${CMAKE_SOURCE_DIR}/src/lapacke/LAPACKE/src/" @@ -795,12 +819,6 @@ set (BLIS1_TARGET_PATH "${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/blis1.h") set (BLIS1__H_SRC_PATH "${CMAKE_SOURCE_DIR}/src/base/flamec/blis/include/blis1.h" ) set (BLIS_FLATTEN_HEADER "${CMAKE_SOURCE_DIR}/build/flatten-headers.py") -if(WIN32) - set (PYTHON_EXE "python") -else() - set (PYTHON_EXE "python3") -endif() - execute_process( COMMAND ${PYTHON_EXE} ${BLIS_FLATTEN_HEADER} "${C_COMMENT}" "${VERBOSE}" "${BLIS1__H_SRC_PATH}" "${BLIS1_TARGET_PATH}" "${BASE_INC_PATH}" "${MK_HEADER_DIR_PATHS}" @@ -862,14 +880,29 @@ include_directories(${CMAKE_SOURCE_DIR}/src/lapacke/LAPACKE/src) include_directories(${CMAKE_SOURCE_DIR}/src/lapacke/LAPACKE/utils) include_directories(${CMAKE_SOURCE_DIR}/src/lapack/x86/front) include_directories(${CMAKE_SOURCE_DIR}/src/lapack/x86/avx2) +include_directories(${CMAKE_SOURCE_DIR}/src/lapack/x86/avx512) include_directories(${CMAKE_SOURCE_DIR}/src/lapack/fblas/front) include_directories(${CMAKE_SOURCE_DIR}/src/lapack/fblas/src) +if(ENABLE_AOCL_BLAS) + include_directories(${BLAS_INCLUDE_DIR}) +endif() + file(GLOB headers ${CMAKE_SOURCE_DIR}/*.h) -if(MSVC) - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /MT ") +if(WIN32) + cmake_policy(SET CMP0091 NEW) + if(BUILD_SHARED_LIBS) + set(CMAKE_MSVC_RUNTIME_LIBRARY "MultiThreaded$<$:Debug>DLL") + else() + set(CMAKE_MSVC_RUNTIME_LIBRARY "MultiThreaded$<$:Debug>") + endif() endif() +set(OBJECT_LIBRARIES + $ + $ +) + if (BUILD_SHARED_LIBS) if(WIN32) set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS ON) @@ -877,6 +910,7 @@ if (BUILD_SHARED_LIBS) add_library("${PROJECT_NAME}" SHARED ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/blis1.h ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/FLA_f2c.h ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/FLAME.h + ${OBJECT_LIBRARIES} ) message(STATUS "Shared library PROJECT_NAME: ${PROJECT_NAME}") target_compile_definitions("${PROJECT_NAME}" PUBLIC -DLIBFLAME_IS_BUILDING_LIBRARY) @@ -886,11 +920,17 @@ else () add_library("${PROJECT_NAME}" STATIC ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/blis1.h ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/FLA_f2c.h ${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}/FLAME.h + ${OBJECT_LIBRARIES} ) message(STATUS "Static library PROJECT_NAME: ${PROJECT_NAME}") endif () +if(WIN32) + set(CMAKE_INSTALL_PREFIX "${CMAKE_INSTALL_PREFIX}" CACHE STRING "AOCL-LAPACK lib/ include/ installation path") +endif() +message(STATUS "CMAKE_INSTALL_PREFIX : ${CMAKE_INSTALL_PREFIX}") + set(LIBFLAME_PUBLIC_HEADERS "include/FLAME.h" "src/lapacke/LAPACKE/include/lapacke_mangling.h" "src/lapacke/LAPACKE/include/lapacke.h" @@ -902,6 +942,7 @@ set_target_properties(${PROJECT_NAME} PROPERTIES PUBLIC_HEADER "${LIBFLAME_PUBLI install(TARGETS ${PROJECT_NAME} LIBRARY DESTINATION ${CMAKE_INSTALL_PREFIX}/lib ARCHIVE DESTINATION ${CMAKE_INSTALL_PREFIX}/lib + RUNTIME DESTINATION ${CMAKE_INSTALL_PREFIX}/lib PUBLIC_HEADER DESTINATION ${CMAKE_INSTALL_PREFIX}/include) #Logic to create AOCL-libFLAME library name according to the linking AOCL-BLIS library name. @@ -916,11 +957,17 @@ if(ENABLE_OPENMP) if(EXT_OPENMP_PATH) if(NOT EXISTS ${EXT_OPENMP_PATH}/${EXT_OPENMP_LIB}) message(FATAL_ERROR "\n Invalid path to openmp Library \n \ - ${EXT_OPENMP_PATH}/${EXT_OPENMP_LIB} \ - Does not exist.\n Please check the path again") + ${EXT_OPENMP_PATH}/${EXT_OPENMP_LIB} \ + Does not exist.\n Please check the path again") + endif() + + find_library(LIBIOMP ${EXT_OPENMP_LIB} ${EXT_OPENMP_PATH} NO_DEFAULT_PATH) + message("User provided OpenMP library path ${LIBIOMP}") + + target_link_libraries(${PROJECT_NAME} ${LIBIOMP}) + if(UNIX) + target_link_libraries(${PROJECT_NAME} -Wl,--as-needed -ldl) endif() - find_library(LIBIOMP ${EXT_OPENMP_LIB} ${EXT_OPENMP_PATH} ) - target_link_libraries(${PROJECT_NAME} ${LIBIOMP}) else() target_link_libraries(${PROJECT_NAME} OpenMP::OpenMP_CXX) endif() @@ -938,24 +985,42 @@ if(NOT BUILD_SHARED_LIBS) endif () endif() -#AOCLUtils library path handling -#If user has provided the library path, use it. -if(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) +if (ENABLE_AOCL_BLAS) + add_definitions(-DFLA_ENABLE_AOCL_BLAS) + set(FLA_ENABLE_AOCL_BLAS 1) + message(STATUS "Enabled FLA_ENABLE_AOCL_BLAS flag") + target_link_libraries(${PROJECT_NAME} ${BLAS_LIBRARY}) +endif () + + target_include_directories(${PROJECT_NAME} PUBLIC src/lapack/x86/avx2) + target_include_directories(${PROJECT_NAME} PUBLIC src/lapack/x86/avx512) + target_include_directories(${PROJECT_NAME} PUBLIC src/lapack/x86/front) + +#If embedding AOCL-UTILS library in AOCL-LAPACK option is selected +if(ENABLE_EMBED_AOCLUTILS) + #AOCLUtils library path handling + #If user has provided the library path, use it. + if(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) message(STATUS "User provided AOCLUtils library path : " ${LIBAOCLUTILS_LIBRARY_PATH}) message(STATUS "User provided AOCLUtils library headers path : " ${LIBAOCLUTILS_INCLUDE_PATH}) target_include_directories(${PROJECT_NAME} PUBLIC ${LIBAOCLUTILS_INCLUDE_PATH}) -else(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) - #Else build from source + else(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) + #Else build from source if EMBED_AOCLUTILS is selected message(STATUS "LIBAOCLUTILS_LIBRARY_PATH and LIBAOCLUTILS_INCLUDE_PATH flags not provded") set(LIBAOCLUTILS_SOURCE_DIR "${CMAKE_CURRENT_BINARY_DIR}/${LIBAOCLUTILS_PROJECT}-prefix/src/${LIBAOCLUTILS_PROJECT}") + set(LIBAOCLUTILS_INSTALL_DIR "${CMAKE_CURRENT_BINARY_DIR}/${LIBAOCLUTILS_PROJECT}-prefix/src/${LIBAOCLUTILS_PROJECT}-build/${LIBAOCLUTILS_INSTALL_DIR_NAME}") + if(UNIX) + set(CHECK_LIB_EXISTS ${LIBAOCLUTILS_INSTALL_DIR}) + elseif(WIN32) + set(CHECK_LIB_EXISTS "${LIBAOCLUTILS_INSTALL_DIR}/lib/*.lib") + endif () message(STATUS "Check AOCL Utils path ${LIBAOCLUTILS_SOURCE_DIR} exists..") - if (EXISTS ${LIBAOCLUTILS_SOURCE_DIR}) + if (EXISTS ${CHECK_LIB_EXISTS}) message(STATUS "Found AOCL Utils source directory. Won't rebuild it") - set(LIBAOCLUTILS_INSTALL_DIR "${CMAKE_CURRENT_BINARY_DIR}/${LIBAOCLUTILS_PROJECT}-prefix/src/${LIBAOCLUTILS_PROJECT}-build/${LIBAOCLUTILS_INSTALL_DIR_NAME}") else() message(STATUS "AOCLUtils library neither provided by user nor earlier build exists. Downloading from GitHub repository") message(STATUS "libaoclutils will be cloned from URL ${LIBAOCLUTILS_GIT_URL} and tag ${LIBAOCLUTILS_GIT_TAG}") @@ -966,6 +1031,7 @@ else(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) GIT_REPOSITORY ${LIBAOCLUTILS_GIT_URL} GIT_TAG ${LIBAOCLUTILS_GIT_TAG} CMAKE_ARGS -DCMAKE_INSTALL_PREFIX=${LIBAOCLUTILS_INSTALL_DIR_NAME} + UPDATE_DISCONNECTED TRUE LOG_DOWNLOAD TRUE LOG_CONFIGURE TRUE LOG_BUILD TRUE @@ -986,13 +1052,13 @@ else(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) set(LIBAOCLUTILS_LIBRARY_PATH ${LIBAOCLUTILS_INSTALL_DIR}/lib/${LIBAOCLUTILS_STATICLIB}) target_include_directories(${PROJECT_NAME} PUBLIC ${LIBAOCLUTILS_SOURCE_DIR}/include) -endif() + endif() -#For libflame shared library, Link directly with libaoclutils library -#For libflame static library, merge libaoclutils and libflame binaries into a single static library -if(BUILD_SHARED_LIBS) + #For libflame shared library, Link directly with libaoclutils library + #For libflame static library, merge libaoclutils and libflame binaries into a single static library + if(BUILD_SHARED_LIBS) target_link_libraries(${PROJECT_NAME} ${LIBAOCLUTILS_LIBRARY_PATH}) -else () + else () if(UNIX) #Merge libflame and libaoclutils libraries in post build step using archive command add_custom_command(TARGET ${PROJECT_NAME} @@ -1012,12 +1078,31 @@ else () COMMENT "Merging libflame and libaoclutils libraries" ) endif () -endif() + endif() -if(UNIX) + if(UNIX) #Linking with libstdc++ library is needed for libaoclutils library dependency target_link_libraries(${PROJECT_NAME} "libstdc++.so") -endif () + endif () + +elseif(BUILD_SHARED_LIBS) + if(LIBAOCLUTILS_LIBRARY_PATH AND LIBAOCLUTILS_INCLUDE_PATH) + target_include_directories(${PROJECT_NAME} PUBLIC ${LIBAOCLUTILS_INCLUDE_PATH}) + target_link_libraries(${PROJECT_NAME} ${LIBAOCLUTILS_LIBRARY_PATH}) + else() + message(FATAL_ERROR "Shared Library build requires AOCL-Utils library and header path to be set! Please set the same using LIBAOCLUTILS_LIBRARY_PATH and LIBAOCLUTILS_INCLUDE_PATH options respectively") + + endif() + +elseif(LIBAOCLUTILS_INCLUDE_PATH) + + message(STATUS "User provided AOCLUtils library headers path : " ${LIBAOCLUTILS_INCLUDE_PATH}) + + target_include_directories(${PROJECT_NAME} PUBLIC ${LIBAOCLUTILS_INCLUDE_PATH}) + +else() + message(FATAL_ERROR "Header file path of aocl-utils library not set! Please set the same using LIBAOCLUTILS_INCLUDE_PATH option") +endif() # TODO : enable this flag to build source supplied blas library # link externally built blas library @@ -1032,7 +1117,9 @@ add_definitions(-DEXPMODULE) add_subdirectory(src) if (BUILD_TEST OR BUILD_LEGACY_TEST) - +# enable ctest +enable_testing() +message(STATUS "CTEST ENABLED") # CHECKS if blas library exists if(NOT EXISTS ${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH}/${EXT_BLAS_LIBNAME}) message(FATAL_ERROR "\n Invalid path to blas Library \n \ @@ -1040,16 +1127,28 @@ ${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH}/${EXT_BLAS_LIBNAME} \ Does not exist.\n Please check the path again") else() add_library(blas SHARED IMPORTED) + add_library(aoclutils SHARED IMPORTED) + if(NOT ENABLE_EMBED_AOCLUTILS AND NOT EXISTS ${LIBAOCLUTILS_LIBRARY_PATH}) + message(FATAL_ERROR "aocl-utils library path not set! Please set the same using LIBAOCLUTILS_LIBRARY_PATH option") + endif() if(UNIX) set_target_properties(blas PROPERTIES IMPORTED_LOCATION ${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH}/${EXT_BLAS_LIBNAME} POSITION_INDEPENDENT_CODE ON ) + set_target_properties(aoclutils PROPERTIES + IMPORTED_LOCATION ${LIBAOCLUTILS_LIBRARY_PATH} + POSITION_INDEPENDENT_CODE ON + ) elseif(WIN32) set_target_properties(blas PROPERTIES IMPORTED_IMPLIB ${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH}/${EXT_BLAS_LIBNAME} POSITION_INDEPENDENT_CODE ON ) + set_target_properties(aoclutils PROPERTIES + IMPORTED_IMPLIB ${LIBAOCLUTILS_LIBRARY_PATH} + POSITION_INDEPENDENT_CODE ON + ) endif() endif() @@ -1076,7 +1175,11 @@ if(BUILD_LEGACY_TEST) endif() if (BUILD_NETLIB_TEST) - add_subdirectory(netlib-test) + if(WIN32) + add_subdirectory(netlib-test) + else() + include(${CMAKE_CURRENT_SOURCE_DIR}/netlib-test/netlib_ctest.cmake) + endif() endif() if(BUILD_LAPACKE_TEST) diff --git a/Makefile b/Makefile index 44c264c36..521215100 100644 --- a/Makefile +++ b/Makefile @@ -286,7 +286,6 @@ PARENT_PATH := ./$(OBJ_DIR)/$(HOST) # Create a list of the makefile fragments. MAKEFILE_FRAGMENTS := $(addsuffix /$(FRAGMENT_MK), $(FRAGMENT_DIR_PATHS)) - # Detect whether we actually got any makefile fragments. If we didn't, then it # is likely that the user has not yet generated them (via configure). ifeq ($(strip $(MAKEFILE_FRAGMENTS)),) @@ -339,10 +338,23 @@ MK_HEADER_FILES := $(strip $(MK_HEADER_FILES)) # Then, strip the header filename to leave the path to each header location. # Notice this process even weeds out duplicates! Add the config directory manually # since it contains FLA_config.h. + MK_HEADER_DIR_PATHS := $(dir $(foreach frag_path, $(FRAGMENT_DIR_PATHS), \ $(firstword $(wildcard $(frag_path)/*.h)))) MK_HEADER_DIR_PATHS += $(BASE_CONFIG_PATH) +# Create list of header file paths to be not included for flattening. +# These paths will be removed from the list of search directories used +# for flattening. + +MK_EXC_HEADER_PATHS := ./src/lapack/x86/ +MK_EXC_HEADER_PATHS += ./src/lapack/x86/avx2/ +MK_EXC_HEADER_PATHS += ./src/lapack/x86/avx512/ +MK_EXC_HEADER_PATHS += ./src/lapack/x86/front/ + +# Remove the header paths in exclude list +MK_HEADER_DIR_PATHS := $(filter-out $(MK_EXC_HEADER_PATHS), $(MK_HEADER_DIR_PATHS)) + # Define a list of headers to flatten. We have to flatten blis1.h and FLA_f2c.h # because a few files #include only those files, but they aren't needed after # libflame is compiled. @@ -378,9 +390,18 @@ INCLUDE_PATHS += $(strip $(patsubst %, -I%, $(L2F_HEADER_DIR_PATHS))) endif INCLUDE_PATHS += $(strip $(patsubst %, -I%, $(LAPACKE_HEADERS_DIR))) +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) ifeq ($(strip $(LIBAOCLUTILS_LIBRARY_PATH)),) INCLUDE_PATHS += "-I$(LIBAOCLUTILS_DIR)/$(LIBAOCLUTILS_REPO)/include" endif +endif + +$(info MK_EXC_HEADER_PATHS is $(MK_EXC_HEADER_PATHS)) +$(info INCLUDE_PATHS is $(INCLUDE_PATHS)) + +# Add the paths of non-flattened header files to INCLUDE_PATHS +MK_EXC_HEADER_PATHS := $(strip $(patsubst %, -I%, $(MK_EXC_HEADER_PATHS))) +INCLUDE_PATHS += $(MK_EXC_HEADER_PATHS) # Add the include flags determined above to various compiler flags variables. CFLAGS := $(CFLAGS) $(INCLUDE_PATHS) @@ -388,6 +409,7 @@ CFLAGS_NOOPT := $(CFLAGS_NOOPT) $(INCLUDE_PATHS) CPPFLAGS := $(CPPFLAGS) $(INCLUDE_PATHS) FFLAGS := $(FFLAGS) $(INCLUDE_PATHS) CFLAGS_AVX := $(CFLAGS_AVX) $(INCLUDE_PATHS) +CFLAGS_AVX512 := $(CFLAGS_AVX512) $(INCLUDE_PATHS) # # --- Library object definitions ----------------------------------------------- @@ -463,6 +485,7 @@ MK_ALL_FLAMEC_OBJS := $(MK_FLABLAS_F2C_OBJS) \ $(MK_ALL_FLAMEC_OBJS) endif +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) ifeq ($(strip $(LIBAOCLUTILS_LIBRARY_PATH)),) LIBAOCLUTILS_OBJS := else @@ -473,6 +496,7 @@ LIBAOCLUTILS_OBJS := $(shell mkdir -p $(LIBAOCLUTILS_OBJ_DIR); \ MK_ALL_FLAMEC_OBJS := $(LIBAOCLUTILS_OBJS) \ $(MK_ALL_FLAMEC_OBJS) endif +endif ### Kyungjoo 2015.10.21 #AR_CHUNK_SIZE=4096 @@ -484,8 +508,10 @@ AR_CHUNK_SIZE=1024 # --- Primary targets --- +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) ifeq ($(strip $(LIBAOCLUTILS_LIBRARY_PATH)),) all: aoclutillib libs +endif else all: libs endif @@ -515,7 +541,7 @@ ifeq ($(MAKEFILE_FRAGMENTS_PRESENT),no) endif aoclutillib: - bash script_aoclutil.sh + bash script_aoclutil.sh LIBAOCLUTILS_GIT_URL=$(LIBAOCLUTILS_GIT_URL) LIBAOCLUTILS_GIT_TAG=$(LIBAOCLUTILS_GIT_TAG) # --- Cosolidated header creation --- @@ -567,6 +593,14 @@ else @$(CC) $(CFLAGS_AVX) -c $< -o $@ endif +FLA_AVX512PATH=lapack/x86/avx512 +$(BASE_OBJ_PATH)/$(FLA_AVX512PATH)/%.o: $(SRC_PATH)/$(FLA_AVX512PATH)/%.c $(CONFIG_MK_FILE) $(HEADERS_TO_FLATTEN) +ifeq ($(ENABLE_VERBOSE),yes) + $(CC) $(CFLAGS_AVX512) -c $< -o $@ +else + @echo "Compiling $<" + @$(CC) $(CFLAGS_AVX512) -c $< -o $@ +endif FLA_SLAMCH=base/flamec/util/lapack/mch/fla_slamch $(BASE_OBJ_PATH)/$(FLA_SLAMCH).o: $(SRC_PATH)/$(FLA_SLAMCH).c $(CONFIG_MK_FILE) $(HEADERS_TO_FLATTEN) ifeq ($(ENABLE_VERBOSE),yes) @@ -637,7 +671,11 @@ ifeq ($(OS_NAME),Darwin) # $(CAT) $(AR_OBJ_LIST_FILE) >> $(AR_ARG_LIST_FILE) # $(AR) @$(AR_ARG_LIST_FILE) else +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) $(file > $@.in,$^ $(shell ls $(LIBAOCLUTILS_OBJ_DIR)/*.o)) +else + $(file > $@.in,$^) +endif $(AR) $(ARFLAGS) $@ @$@.in $(RM_F) $@.in endif @@ -660,7 +698,11 @@ ifeq ($(OS_NAME),Darwin) # @$(CAT) $(AR_OBJ_LIST_FILE) >> $(AR_ARG_LIST_FILE) # @$(AR) @$(AR_ARG_LIST_FILE) else +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) @$(file > $@.in,$^ $(shell ls $(LIBAOCLUTILS_OBJ_DIR)/*.o)) +else + @$(file > $@.in,$^) +endif @$(AR) $(ARFLAGS) $@ @$@.in @$(RM_F) $@.in endif @@ -684,7 +726,11 @@ ifeq ($(OS_NAME),Darwin) $(CAT) $(AR_OBJ_LIST_FILE) | xargs -n$(AR_CHUNK_SIZE) $(AR) $(ARFLAGS) $(LIBFLAME_A) $(LINKER) $(SOFLAGS) -o $@ -Wl,-force_load,$(LIBFLAME_A) $(LDFLAGS) else +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) $(file > $@.in,$^ $(shell ls $(LIBAOCLUTILS_OBJ_DIR)/*.o)) +else + @$(file > $@.in,$^) +endif $(LINKER) $(SOFLAGS) -o $(LIBFLAME_SO_OUTPUT_NAME) @$@.in $(LDFLAGS) $(RM_F) $@.in endif @@ -700,7 +746,11 @@ ifeq ($(OS_NAME),Darwin) @$(CAT) $(AR_OBJ_LIST_FILE) | xargs -n$(AR_CHUNK_SIZE) $(AR) $(ARFLAGS) $(LIBFLAME_A) @$(LINKER) $(SOFLAGS) -o $@ -Wl,-force_load,$(LIBFLAME_A) $(LDFLAGS) else +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) @$(file > $@.in,$^ $(shell ls $(LIBAOCLUTILS_OBJ_DIR)/*.o)) +else + @$(file > $@.in,$^) +endif @$(LINKER) $(SOFLAGS) -o $(LIBFLAME_SO_OUTPUT_NAME) @$@.in $(LDFLAGS) @$(RM_F) $@.in endif @@ -946,8 +996,10 @@ ifeq ($(ENABLE_VERBOSE),yes) - $(RM_F) $(AOCLDTL_obj_PATH) - $(RM_F) $(AOCLDTL_gch_PATH) - $(RM_F) $(BASE_LIB_PATH)/* +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) - $(RM_F) -r $(LIBAOCLUTILS_DIR) - $(RM_F) -r $(LIBAOCLUTILS_OBJ_DIR) +endif else @echo "Removing object files from $(BASE_OBJ_PATH)" @$(FIND) $(BASE_OBJ_PATH) -name "*.o" | $(XARGS) $(RM_F) @@ -959,10 +1011,12 @@ else @$(RM_F) $(AOCLDTL_obj_PATH) @$(RM_F) $(AOCLDTL_gch_PATH) @$(RM_F) $(BASE_LIB_PATH)/* +ifeq ($(ENABLE_EMBED_AOCLUTILS),1) @$(RM_F) -r $(LIBAOCLUTILS_DIR) @$(RM_F) -r $(LIBAOCLUTILS_OBJ_DIR) endif endif +endif distclean: cleanmk cleanh cleanlib ifeq ($(IS_CONFIGURED),yes) diff --git a/build/auto_config.py b/build/auto_config.py new file mode 100644 index 000000000..6dd225682 --- /dev/null +++ b/build/auto_config.py @@ -0,0 +1,103 @@ +"""Copyright (C) 2023, Advanced Micro Devices, Inc. All Rights Reserved""" + +import platform +import re +import subprocess +import sys + +def config_check(): + # Execute wmic shell command with sub-process + global model, family, vendor, stepping + if 'Windows' in platform.system(): + result = subprocess.Popen( + 'wmic cpu get caption', shell=True, + stdout=subprocess.PIPE, stderr=subprocess.PIPE).communicate() + result = result[0].decode('utf-8') + # Replace the newline character with empty char + result = result.replace('\n', '') + + # parse the string into list of string + parse_string = result.split(" ") + + # Strip the empty strings from list + parse_string = [data for data in parse_string if data.strip()] + + vendor = parse_string[1] + family = int(parse_string[3]) + model = int(parse_string[5]) + stepping = int(parse_string[7]) + + elif 'Linux' in platform.system(): + result = subprocess.Popen( + 'lscpu', shell=True, + stdout=subprocess.PIPE, stderr=subprocess.PIPE).communicate() + stepping = int(re.findall(r'\WStepping:.*', result[0].decode( + 'utf-8'), re.MULTILINE)[0].strip('\n').split(' ')[-1]) + family = int(re.findall(r'\WCPU family:.*', result[0].decode( + 'utf-8'), re.MULTILINE)[0].strip('\n').split(' ')[-1]) + model = int(re.findall(r'\WModel:.*', result[0].decode('utf-8'), + re.MULTILINE)[0].strip('\n').split(' ')[-1]) + vendor = re.findall(r'\WModel name:.*', result[0].decode( + 'utf-8'), re.MULTILINE)[0].strip('\n').split('Model name:')[-1] + # AMD family numbers + # Zen/Zen+/Zen2 (0x17) and Zen3/Zen4 (0x19) family numbers + zen_family = [23, 25] + # Bulldozer / Piledriver / Steamroller / Excavator family number + amd_family = 21 + + # AMD CPUID model numbers + zen_model = [48, 255] + zen2_model = [0, 255] + zen3_model = [(0, 15), (32, 95)] + zen4_model = [(16, 31), (96, 175)] + excavator_model = [96, 127] + steamroller_model = [48, 63] + piledriver_model = [2, 16, 31] + bulldozer_model = [0, 1] + + # Check the CPU configuration Intel64/AMD64 + if vendor.count("Intel64"): + return + elif 'AMD' in vendor: # .count("AMD64"): + # Check the AMD family name + if family == zen_family[0]: + if zen_model[0] <= model <= zen_model[1]: + family="zen2" + elif zen2_model[0] <= model <= zen2_model[1]: + family="zen" + else: + print("Unknown model number") + elif family == zen_family[1]: + if (zen3_model[0][0] <= model <= zen3_model[0][1]) or ( + zen3_model[1][0] <= model <= zen3_model[1][1]): + family="zen3" + elif (zen4_model[0][0] <= model <= zen4_model[0][1]) or ( + zen4_model[1][0] <= model <= zen4_model[1][1]): + family="zen4" + else: + print("Unknown model number zen4") + elif family == amd_family: + # check for specific models of excavator family + if excavator_model[0] <= model <= excavator_model[1]: + family="excavator" + # check for specific models of steamroller family + elif steamroller_model[0] <= model <= steamroller_model[1]: + family="steamroller" + # check for specific models of piledriver family + elif model == piledriver_model[0] or ( + piledriver_model[1] <= model <= piledriver_model[2]): + family="piledriver" + # check for specific models of bulldozer family + elif model == bulldozer_model[0] or model == bulldozer_model[1]: + family="bulldozer" + else: + print("Unknown model number") + else: + print("Unknown family") + else: + print("UNKNOWN CPU") + return family + +# Function call for config family names +config = config_check() +print(config) diff --git a/build/config.mk.in b/build/config.mk.in index 1c333989c..ec1c1cfcc 100644 --- a/build/config.mk.in +++ b/build/config.mk.in @@ -133,6 +133,7 @@ endif # Add AVX and FMA flags for specific files CAVXFLAGS := -mavx2 -mfma +CAVX512FLAGS := -mavx512f -mfma # Aggregate all of the flags into two groups: one for optimizable code, and # one for code that should not be optimized. @@ -140,6 +141,7 @@ CFLAGS := $(strip $(CDBGFLAGS) $(COPTFLAGS) $(CVECFLAGS) $(CWARNFLAGS) $(C CFLAGS_NOOPT := $(strip $(CDBGFLAGS) $(CWARNFLAGS) $(CMISCFLAGS) $(CPPROCFLAGS)) CXXFLAGS := $(strip $(CDBGFLAGS) $(COPTFLAGS) $(CVECFLAGS) $(CWARNFLAGS) $(CXXMISCFLAGS) $(CPPROCFLAGS)) CFLAGS_AVX := $(strip $(CDBGFLAGS) $(COPTFLAGS) $(CVECFLAGS) $(CWARNFLAGS) $(CMISCFLAGS) $(CPPROCFLAGS) $(CAVXFLAGS)) +CFLAGS_AVX512 := $(strip $(CDBGFLAGS) $(COPTFLAGS) $(CVECFLAGS) $(CWARNFLAGS) $(CMISCFLAGS) $(CPPROCFLAGS) $(CAVX512FLAGS)) # If the user provided his own CFLAGS, allow them to override our own. # *** Notice that wo do not also modify the 'no optimization' set of flags. diff --git a/cmake/find_aocl-blas.cmake b/cmake/find_aocl-blas.cmake new file mode 100644 index 000000000..483d99cb7 --- /dev/null +++ b/cmake/find_aocl-blas.cmake @@ -0,0 +1,117 @@ +# ######################################################################## +#Copyright(c) 2023 Advanced Micro Devices, Inc. +# +#Permission is hereby granted, free of charge, to any person obtaining a copy +#of this software and associated documentation files(the "Software"), to deal +#in the Software without restriction, including without limitation the rights +#to use, copy, modify, merge, publish, distribute, sublicense, and / or sell +#copies of the Software, and to permit persons to whom the Software is +#furnished to do so, subject to the following conditions: +# +#The above copyright notice and this permission notice shall be included in +#all copies or substantial portions of the Software. +# +#THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +#IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +#FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE +#AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +#LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +#OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +#THE SOFTWARE. +# +# ######################################################################## + +# ============= aocl function ================ +function(aocl_libs) + + IF(FLA_ENABLE_ILP64) + SET(ILP_DIR "ILP64") + ELSE(FLA_ENABLE_ILP64) + SET(ILP_DIR "LP64") + ENDIF(FLA_ENABLE_ILP64) + + IF(WIN32) + SET(CMAKE_FIND_LIBRARY_PREFIXES "") + SET(CMAKE_FIND_LIBRARY_SUFFIXES ".lib") + find_library(AOCL_BLAS_LIB + NAMES AOCL-LibBlis-Win-MT AOCL-LibBlis-Win-MT-dll AOCL-LibBlis-Win AOCL-LibBlis-Win-dll + HINTS ${AOCL_ROOT}/blis ${AOCL_ROOT}/amd-blis ${AOCL_ROOT} + PATH_SUFFIXES "lib/${ILP_DIR}" "lib_${ILP_DIR}" "lib" + DOC "AOCL-BLAS library" + ) + + #====Headers + find_path(AOCL_BLAS_INCLUDE_DIR + NAMES blis.h cblas.h + HINTS ${AOCL_ROOT}/amd-blis ${AOCL_ROOT}/blis ${AOCL_ROOT} + PATH_SUFFIXES "include/${ILP_DIR}" "include_${ILP_DIR}" "include" "include/blis" + DOC "AOCL-BLAS headers" + ) + + ELSE(WIN32) + SET(CMAKE_FIND_LIBRARY_PREFIXES "lib") + IF(BUILD_SHARED_LIBS) + SET(CMAKE_FIND_LIBRARY_SUFFIXES ".so") + ELSE(BUILD_SHARED_LIBS) + SET(CMAKE_FIND_LIBRARY_SUFFIXES ".a") + ENDIF(BUILD_SHARED_LIBS) + + find_library(AOCL_BLAS_LIB + NAMES blis-mt blis + HINTS ${AOCL_ROOT}/blis ${AOCL_ROOT}/amd-blis ${AOCL_ROOT} + PATH_SUFFIXES "lib/${ILP_DIR}" "lib_${ILP_DIR}" "lib" + DOC "AOCL-BLAS library" + ) + + #====Headers + find_path(AOCL_BLAS_INCLUDE_DIR + NAMES blis.h blis.hh cblas.h cblas.hh + HINTS ${AOCL_ROOT}/blis ${AOCL_ROOT}/amd-blis ${AOCL_ROOT} + PATH_SUFFIXES "include/${ILP_DIR}" "include_${ILP_DIR}" "include" "include/blis" + DOC "AOCL-BLAS headers" + ) + + ENDIF(WIN32) + + #=========== + if(AOCL_BLAS_LIB AND AOCL_BLAS_INCLUDE_DIR) + set(AOCL_BLAS_FOUND true PARENT_SCOPE) + set(BLAS_LIBRARY ${AOCL_BLAS_LIB}) + else() + message (FATAL_ERROR "Error: could not find a suitable installation of AOCL-BLAS Library in \$AOCL_ROOT=${AOCL_ROOT}") + endif() + + set(BLAS_LIBRARY ${BLAS_LIBRARY} PARENT_SCOPE) + +endfunction(aocl_libs) + +#==================main================= +# clear to avoid endless appending on subsequent calls +set(BLAS_LIBRARY) +unset(BLAS_INCLUDE_DIR) + +if(DEFINED ENV{AOCL_ROOT}) + SET(AOCL_ROOT $ENV{AOCL_ROOT}) + message(STATUS "AOCL_ROOT set via environment variable is ${AOCL_ROOT}") + if(NOT EXISTS ${AOCL_ROOT}) + message(FATAL_ERROR "\n Invalid path to AOCL_ROOT \n") + endif() +elseif(AOCL_ROOT) + SET(AOCL_ROOT ${AOCL_ROOT}) + message(STATUS "AOCL_ROOT set from cmake option is ${AOCL_ROOT}") + if(NOT EXISTS ${AOCL_ROOT}) + message(FATAL_ERROR "\n Invalid path to AOCL_ROOT \n") + endif() +else() + set(AOCL_ROOT ${CMAKE_INSTALL_PREFIX}) +endif() + +aocl_libs() + +set(BLAS_LIBRARY ${BLAS_LIBRARY}) +set(BLAS_INCLUDE_DIR ${AOCL_BLAS_INCLUDE_DIR}) + +message(STATUS "AOCL-BLAS LIBRARY= ${BLAS_LIBRARY}") +message(STATUS "AOCL-BLAS INCLUDE DIRS= ${BLAS_INCLUDE_DIR}") + +mark_as_advanced(BLAS_LIBRARY BLAS_INCLUDE_DIR) diff --git a/configure b/configure index c87549b88..76141d491 100755 --- a/configure +++ b/configure @@ -6129,6 +6129,8 @@ fi $as_echo "#define _GNU_SOURCE 1" >>confdefs.h + ;; + clang) ;; icc) ;; @@ -6155,13 +6157,13 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} language flags... " case ${CC_VENDOR} in gcc) - fla_c_lang_flags='-std=c99 -Wall -Wno-unused-function -Wno-error=implicit-function-declaration -Wno-parentheses -Wfatal-errors' + fla_c_lang_flags='-std=c11' ;; clang) - fla_c_lang_flags='-Wall -Wno-unused-function -Wno-error=implicit-function-declaration -Wno-error=incompatible-function-pointer-types -Wno-parentheses -Wfatal-errors' + fla_c_lang_flags='-std=c11' ;; icc) - fla_c_lang_flags='-std=c99' + fla_c_lang_flags='-std=c11' ;; pathcc) fla_c_lang_flags='-std=c99' @@ -6176,7 +6178,7 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} language flags... " fla_c_lang_flags='-qlanglvl=stdc99 -qstrict -qlargepage -qthreaded' ;; cc) - fla_c_lang_flags='-std=c99' + fla_c_lang_flags='-std=c11' ;; *) fla_c_lang_flags='' @@ -7380,21 +7382,21 @@ $as_echo_n "checking whether to enable compiler warnings... " >&6; } if test "${enable_warnings+set}" = set; then : enableval=$enable_warnings; - if test "$enableval" = "no" ; then + if test "$enableval" = "no" ; then - fla_enable_compiler_warnings=no + fla_enable_compiler_warnings=no elif test "$enableval" = "yes" ; then - fla_enable_compiler_warnings=yes + fla_enable_compiler_warnings=yes else - as_fn_error $? "Reached unreachable branch in FLA_CHECK_ENABLE_WARNINGS!" "$LINENO" 5 + as_fn_error $? "Reached unreachable branch in FLA_CHECK_ENABLE_WARNINGS!" "$LINENO" 5 fi else - fla_enable_compiler_warnings=yes + fla_enable_compiler_warnings=yes fi @@ -7423,9 +7425,12 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} warning flags... " if test "$fla_enable_compiler_warnings" == "yes" ; then - case ${CC_VENDOR} in + case ${CC_VENDOR} in gcc) - fla_c_warning_flags='-Wall -Wno-comment' + fla_c_warning_flags='-Wall -Wno-comment -Wno-unused-function -Wno-error=implicit-function-declaration -Wno-parentheses -Wfatal-errors' + ;; + clang) + fla_c_warning_flags='-Wall -Wno-comment -Wno-unused-function -Wno-error=implicit-function-declaration -Wno-error=incompatible-function-pointer-types -Wno-parentheses -Wfatal-errors' ;; icc) fla_c_warning_flags='-Wall -wd869,981,1418,1419,1572' @@ -7451,9 +7456,12 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} warning flags... " esac else - case ${CC_VENDOR} in + case ${CC_VENDOR} in gcc) - fla_c_warning_flags='-w' + fla_c_warning_flags='-w -Wno-error=implicit-function-declaration' + ;; + clang) + fla_c_warning_flags='-w -Wno-error=implicit-function-declaration' ;; icc) fla_c_warning_flags='-w' @@ -7543,6 +7551,9 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} debug flags... " >& case ${CC_VENDOR} in gcc) fla_c_debug_flags='-g' + ;; + clang) + fla_c_debug_flags='-g' ;; icc) fla_c_debug_flags='-g' @@ -7571,6 +7582,9 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} debug flags... " >& case ${CC_VENDOR} in gcc) fla_c_debug_flags='-g0' + ;; + clang) + fla_c_debug_flags='' ;; icc) fla_c_debug_flags='' @@ -7661,6 +7675,9 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} profiling flags... case ${CC_VENDOR} in gcc) fla_c_prof_flags='-pg' + ;; + clang) + fla_c_prof_flags='-pg' ;; icc) fla_c_prof_flags='-p' @@ -7689,6 +7706,9 @@ $as_echo_n "checking for (guessing) appropriate ${CC_VENDOR} profiling flags... case ${CC_VENDOR} in gcc) fla_c_prof_flags='' + ;; + clang) + fla_c_prof_flags='' ;; icc) fla_c_prof_flags='' diff --git a/configure_tidsp b/configure_tidsp index 59b691969..751a5262c 100755 --- a/configure_tidsp +++ b/configure_tidsp @@ -1600,7 +1600,8 @@ Optional Features: --enable-tidsp Enable code required for libflame to run under Texas Instruments' DSP. Note that this option is experimental. (Disabled by default.) - --enable-amd-opt Enable code to take AMD optimized path by enabling the FLA_AMD_OPT macro. (Disabled by default.) + --enable-amd-opt Enable code to take AMD optimized path by enabling + the FLA_ENABLE_AMD_OPT macro. (Disabled by default.) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] diff --git a/generate_code_coverage_html.sh b/generate_code_coverage_html.sh new file mode 100644 index 000000000..5370413a1 --- /dev/null +++ b/generate_code_coverage_html.sh @@ -0,0 +1,11 @@ +#!/bin/bash + +lcov --rc lcov_branch_coverage=1 --capture --directory . --output-file coverage.info; +lcov --remove --rc lcov_branch_coverage=1 coverage.info '/usr/*' '*/test/*' \ + '*src/base/flamec/hierarchy*' '*src/base/flamec/old*' '*src/base/flamec/alt*' '*src/base/flamec/supermatrix*' \ + '*src/base/flamec/blis*' 'base/flamec/wrappers/blas*' '*src/blas/*' '*src/flablas/*' \ + '*src/aocl_dtl/*' '*src/lapacke/LAPACKE/example*' \ + -o filtered_coverage.info + +genhtml --rc genhtml_branch_coverage=1 --title "LIBFLAME CODE COVERAGE REPORT" filtered_coverage.info --prefix $PWD --function-coverage --branch-coverage --legend --output-directory out; +cd out; pushd <index.html; python3 -m http.server 9999; popd; \ No newline at end of file diff --git a/netlib-test/create_new_testdir.sh b/netlib-test/create_new_testdir.sh index ffab2d27a..70039d0eb 100755 --- a/netlib-test/create_new_testdir.sh +++ b/netlib-test/create_new_testdir.sh @@ -74,19 +74,21 @@ main() mkdir ./${testdir_new}/lapacke cp ./build/lapacke-Makefile ./${testdir_new}/lapacke/Makefile - echo "Tweaking TESTING/LIN/xerbla.f." - echo "Tweaking TESTING/EIG/xerbla.f." + #echo "Tweaking TESTING/LIN/xerbla.f." + #echo "Tweaking TESTING/EIG/xerbla.f." # Disable a part of the custom xerbla_() that tests string equality # since this is broken due to Fortran/C incompatibilities. - xb_lin_in=${netlib_path}/TESTING/LIN/xerbla.f - xb_lin_ou=${testdir_new}/TESTING/LIN/xerbla.f - xb_eig_in=${netlib_path}/TESTING/EIG/xerbla.f - xb_eig_ou=${testdir_new}/TESTING/EIG/xerbla.f - sed_expr="s/SRNAME\.NE\.SRNAMT/\.FALSE./g" - - sed -e "${sed_expr}" ${xb_lin_in} > ${xb_lin_ou} - sed -e "${sed_expr}" ${xb_eig_in} > ${xb_eig_ou} + # (No longer needed due to adaptation of C xerbla to include extra + # string length argument. + #xb_lin_in=${netlib_path}/TESTING/LIN/xerbla.f + #xb_lin_ou=${testdir_new}/TESTING/LIN/xerbla.f + #xb_eig_in=${netlib_path}/TESTING/EIG/xerbla.f + #xb_eig_ou=${testdir_new}/TESTING/EIG/xerbla.f + #sed_expr="s/SRNAME\.NE\.SRNAMT/\.FALSE./g" + + #sed -e "${sed_expr}" ${xb_lin_in} > ${xb_lin_ou} + #sed -e "${sed_expr}" ${xb_eig_in} > ${xb_eig_ou} echo "Tweaking ddrvsg.f" diff --git a/netlib-test/netlib_ctest.cmake b/netlib-test/netlib_ctest.cmake new file mode 100644 index 000000000..b43614f68 --- /dev/null +++ b/netlib-test/netlib_ctest.cmake @@ -0,0 +1,19 @@ +if((NOT EXT_LAPACK_LIBRARY_PATH) OR (NOT EXT_LAPACK_LIBNAME)) + set(EXT_LAPACK_LIBRARY_PATH "${CMAKE_LIBRARY_OUTPUT_DIRECTORY}") + set(EXT_LAPACK_LIBNAME "libflame.a") +endif() +enable_testing() +if(CMAKE_C_COMPILER MATCHES "clang$") + # Run the netlib test using AOCC if clang compiler is detected + set(NETLIB_BASH_SCRIPT ${CMAKE_CURRENT_SOURCE_DIR}/netlib-test/run-netlib-test-aocc.sh) +else() + # Run the netlib test using GCC if gcc compiler is detected + set(NETLIB_BASH_SCRIPT ${CMAKE_CURRENT_SOURCE_DIR}/netlib-test/run-netlib-test.sh) +endif() + +cmake_path(GET LIBAOCLUTILS_LIBRARY_PATH PARENT_PATH AOCLUTILS_LIB_DIR_PATH) + +add_test(netlib-test bash ${NETLIB_BASH_SCRIPT} BLAS_LIB_PATH=${CMAKE_EXT_BLAS_LIBRARY_DEPENDENCY_PATH} BLAS_LIB=${EXT_BLAS_LIBNAME} + LAPACK_LIB_PATH=${EXT_LAPACK_LIBRARY_PATH} LAPACK_LIB=${EXT_LAPACK_LIBNAME} AOCLUTILS_LIB_PATH=${AOCLUTILS_LIB_DIR_PATH} ILP64=${ENABLE_ILP64} GCOV=${ENABLE_GCOV}) + +set_tests_properties(netlib-test PROPERTIES WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/netlib-test) diff --git a/netlib-test/run-netlib-test-aocc.sh b/netlib-test/run-netlib-test-aocc.sh index 8128d151e..f52ce7d19 100644 --- a/netlib-test/run-netlib-test-aocc.sh +++ b/netlib-test/run-netlib-test-aocc.sh @@ -2,15 +2,18 @@ echo echo "Argument Values" -LAPACK_TEST_DIR=lapack-3.10.0 +LAPACK_TEST_DIR=lapack-3.11 BLAS_LIB=libblis-mt.a BLAS_LIB_PATH= LAPACK_LIB=libflame.a LAPACK_LIB_PATH= +AOCLUTILS_LIB_PATH= +AOCLUTILS_LIB=libaoclutils.a DTL_LIB=libaocldtl.a DTL_LIB_PATH= ILP64=0 DTL=0 +AOCL_LAPACK_SUMMARY=1 for ARG in "$@" do @@ -22,11 +25,13 @@ do LAPACK_LIB) LAPACK_LIB=${DATA} ;; BLAS_LIB_PATH) BLAS_LIB_PATH=${DATA} ;; LAPACK_LIB_PATH) LAPACK_LIB_PATH=${DATA} ;; - DTL_LIB_PATH) DTL_LIB_PATH=${DATA} ;; + AOCLUTILS_LIB_PATH) AOCLUTILS_LIB_PATH=${DATA} ;; + DTL_LIB_PATH) DTL_LIB_PATH=${DATA} ;; DTL_LIB) DTL_LIB=${DATA} ;; LAPACK_TEST_DIR) LAPACK_TEST_DIR=${DATA} ;; ILP64) ILP64=${DATA} ;; - DTL) DTL=${DATA} ;; + DTL) DTL=${DATA} ;; + AOCL_LAPACK_SUMMARY) AOCL_LAPACK_SUMMARY=${DATA} ;; *) esac done @@ -35,13 +40,14 @@ echo "BLAS_LIB_PATH = $BLAS_LIB_PATH" echo "BLAS_LIB = $BLAS_LIB" echo "LAPACK_LIB_PATH = $LAPACK_LIB_PATH" echo "LAPACK_LIB = $LAPACK_LIB" +echo "AOCLUTILS_LIB_PATH = $AOCLUTILS_LIB_PATH" echo "LAPACK_TEST_DIR = $LAPACK_TEST_DIR" echo echo echo "**********************************" echo -if [[ $BLAS_LIB_PATH == "" || $LAPACK_LIB_PATH == "" ]] +if [[ $BLAS_LIB_PATH == "" || $LAPACK_LIB_PATH == "" || $AOCLUTILS_LIB_PATH == "" ]] then echo "Error in calling script" echo "----------------------------------" @@ -49,22 +55,24 @@ then echo "Usage :" echo echo "$ sh run-netlib-test-aocc.sh BLAS_LIB_PATH= LAPACK_LIB_PATH= " - echo " [BLAS_LIB=] [ILP64=<0/1>] " - echo " [LAPACK_TEST_DIR=]" + echo " AOCLUTILS_LIB_PATH= [BLAS_LIB=] " + echo " [ILP64=<0/1>] [LAPACK_TEST_DIR=]" echo echo "[] indicates optional argument" echo - echo "Example: $ sh run-netlib-test-aocc.sh BLAS_LIB_PATH=\"/home/user/blis/lib\" LAPACK_LIB_PATH=\"/home/user/libflame/lib\" BLAS_LIB=\"libblis.a\" LAPACK_LIB=\"libflame.a\"" + echo "Example: $ sh run-netlib-test-aocc.sh BLAS_LIB_PATH=\"/home/user/blis/install/lib\" LAPACK_LIB_PATH=\"/home/user/libflame/install/lib\" AOCLUTILS_LIB_PATH=\"/home/user/aoclutils/install/lib\" BLAS_LIB=\"libblis.a\" LAPACK_LIB=\"libflame.a\"" echo echo "BLAS_LIB : blas library to use. Default=libblist-mt.a" - echo "LAPACK_LIB : lapac library to use. Default=libflame.a" + echo "LAPACK_LIB : lapack library to use. Default=libflame.a" echo "DTL_LIB : DTL library binary to be used. Default=libaocldtl.a" echo "DTL : Enable(1) or disable(0) DTL. Default=0" echo "ILP64 : LP64 or ILP64 mode. Default=0(Use LP64)" echo "BLAS_LIB_PATH : path of blas library chosen in BLAS_LIB" echo "LAPACK_LIB_PATH : path to lapack library chosen in LAPACK_LIB" + echo "AOCLUTILS_LIB_PATH : path to aocl-utils library" echo "DTL_LIB_PATH : path to DTL library chosen in DTL_LIB (if DTL is enabled)" echo "LAPACK_TEST_DIR : netlib lapack test directory name. Default=lapack-3.10.0" + echo "AOCL_LAPACK_SUMMARY : run aocl-lapack netlib test suite summary script. Default=1" echo exit 1 fi @@ -101,16 +109,22 @@ fi ulimit -s unlimited FORTRAN_FLAGS="flang -fopenmp" -TESTLAPACKLIB="$PWD/liblapack.a" +TESTLAPACKLIB="$PWD/liblapack.a $AOCLUTILS_LIB_PATH/$AOCLUTILS_LIB" -if [[ $ILP64 = "1" ]] +if [[ $ILP64 =~ ("1"|"ON") ]] then FORTRAN_FLAGS="flang -fopenmp -fdefault-integer-8" fi if [[ $DTL = "1" ]] then - TESTLAPACKLIB="$PWD/liblapack.a $PWD/libaocldtl.a -lpthread" + TESTLAPACKLIB="$TESTLAPACKLIB $PWD/libaocldtl.a -lpthread" fi OMP_NUM_THREADS=1 make CC=clang FC="$FORTRAN_FLAGS" LDFLAGS="-lstdc++ -lpthread -fopenmp" LAPACKLIB="$TESTLAPACKLIB" TIMER=NONE -j + +if [[ $AOCL_LAPACK_SUMMARY = "1" ]] +then + cd .. + python3 run-netlib-test-summary.py +fi diff --git a/netlib-test/run-netlib-test-summary.py b/netlib-test/run-netlib-test-summary.py new file mode 100644 index 000000000..596af4407 --- /dev/null +++ b/netlib-test/run-netlib-test-summary.py @@ -0,0 +1,131 @@ +############################################################################### +# Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +############################################################################### +# +# Script for netlib LAPACK test suite short summary. +# Refer to "libflame/netlib/libflame_netlib/TESTING/testing_results.txt" for detailed summary after +# running the test-suite. +# + +from __future__ import print_function +import re + +FOLDER_NAME = 'libflame_netlib/' #netltest folder +TEST_FILE = FOLDER_NAME+'TESTING/testing_results.txt' #path to summary file generated by netlib-test suite +ENABLE_NETLIB_SUMMARY = 0 #Enable this for netlib short summary + +# List of failure/error patterns +patterns = [ + r'(\w+)\s+drivers:\s+(\d+)\s+out of\s+(\d+)\s+tests failed to pass the threshold', + r'(\w+):\s+(\d+)\s+out of\s+(\d+)\s+tests failed to pass the threshold', + r'(\w+)\s+and (\w+)\s+compute an inconsistent result factor in\s+(\d+)\s+tests', + r'Error in (\w+):\s+(\d+)\s+tests fail the threshold', + r'\*\*\* (\w+)\s+routines failed the tests of the error exits \*\*\*', + r'\*\*\* Error\(s\) or Failure\(s\) while testing (\w+)', + #add patterns here if missing +] + +failed_routines = {} #routine names and corresponding failed tests +total_illegal_errors = 0 #total illegal value errors +total_info_errors = 0 #total info errors +total_failed_tests = 0 #total failed tests (excluding illegal values and exit errors) +encountered_error = 0 + +try: + with open(TEST_FILE, 'r') as file: + lines = file.readlines() + + print("\nAOCL-LAPACK failed routines summary:\n") + for line in lines: + line = ' '.join(line.split()) # Replace multiple spaces with single space + + #check for info and other errors here + if (line.find("illegal")!=-1) or (line.find("Illegal")!=-1): + #print(line.strip()) #print error/failure lines + total_illegal_errors += 1 + + if (line.find(" INFO")!=-1): + #print(line.strip()) #print error/failure lines + total_info_errors += 1 + + match_found = 0 + for pattern in patterns: + match = re.match(pattern, line) + if match and line.find("error exits") == -1: #exit errors are already catched above + match_found = 1 + routine_name = match.group(1) + failed_tests = match.group(2) if len(match.groups()) >= 2 and match.group(2).isdigit() else 0 + + # Extract failed_tests + tests_in_sentence = re.search(r'in\s+(\d+)\s+tests', line) + if tests_in_sentence: + failed_tests = int(tests_in_sentence.group(1)) + + if routine_name in failed_routines: + failed_routines[routine_name] += max(int(failed_tests),1) + else: + failed_routines[routine_name] = max(int(failed_tests),1) + print(line.strip()) #print error/failure lines + break + + #none of the patterns matched but there's a failure + if match_found == 0 and line.find("out of")!=-1 and line.find("error exits")==-1 and line.find("Error(s)")==-1: + total_failed_tests += 1 + + print("*" * 80) + print("Failed routines:") + for routine, failed_tests in failed_routines.items(): + # if failed_tests > 0: + # print(f"* {routine}: {failed_tests} tests failed") + # total_failed_tests += failed_tests + # else: + print("{0} ".format(routine), end="") + + print("") + print("*" * 80) + print("Total illegal value errors: {0}", total_illegal_errors) + print("Total exit tests failing: {0}", total_info_errors) + print("*" * 80) +except: + encountered_error = 1 + +#prints the netlib test summary (code snippet from lapack_testing.py - Netlib LAPACK 3.11) +try: + nb_test_run=0 + nb_test_fail=0 + nb_test_illegal=0 + nb_test_info=0 + with open(TEST_FILE, 'r') as file: + lines = file.readlines() + for line in lines: + words_in_line=line.split() + try: + if (line.find("run")!=-1): + whereisrun=words_in_line.index("run)") + nb_test_run+=int(words_in_line[whereisrun-2]) + if (line.find("out of")!=-1): + whereisout= words_in_line.index("out") + nb_test_fail+=int(words_in_line[whereisout-1]) + if ((line.find("illegal")!=-1) or (line.find("Illegal")!=-1)): + nb_test_illegal+=1 + if (line.find(" INFO")!=-1): + nb_test_info+=1 + except: + continue + + if ENABLE_NETLIB_SUMMARY: + print("Netlib short summary: ") + print("") + print("Total failed test: ",nb_test_fail) + print("Total illegal value failed test: ",nb_test_illegal) + print("Total exit errors: ",nb_test_info) + print("*" * 80) +except: + encountered_error = 1 + + +#print the max failed tests from netlib and aocl-lapack summary +if encountered_error == 0: + print("Total failed tests: ",max(nb_test_fail, total_failed_tests)) +else: + print("\n*** Encountered unexpected error while running the script! Check testing_results.txt ***\n") diff --git a/netlib-test/run-netlib-test.sh b/netlib-test/run-netlib-test.sh index e41711b40..698cad8ec 100644 --- a/netlib-test/run-netlib-test.sh +++ b/netlib-test/run-netlib-test.sh @@ -2,15 +2,19 @@ echo echo "Argument Values" -LAPACK_TEST_DIR=lapack-3.10.0 +LAPACK_TEST_DIR=lapack-3.11 BLAS_LIB=libblis-mt.a BLAS_LIB_PATH= LAPACK_LIB=libflame.a LAPACK_LIB_PATH= +AOCLUTILS_LIB_PATH= +AOCLUTILS_LIB=libaoclutils.a DTL_LIB=libaocldtl.a DTL_LIB_PATH= ILP64=0 DTL=0 +GCOV=0 +AOCL_LAPACK_SUMMARY=1 for ARG in "$@" do @@ -22,11 +26,14 @@ do LAPACK_LIB) LAPACK_LIB=${DATA} ;; BLAS_LIB_PATH) BLAS_LIB_PATH=${DATA} ;; LAPACK_LIB_PATH) LAPACK_LIB_PATH=${DATA} ;; + AOCLUTILS_LIB_PATH) AOCLUTILS_LIB_PATH=${DATA} ;; DTL_LIB_PATH) DTL_LIB_PATH=${DATA} ;; DTL_LIB) DTL_LIB=${DATA} ;; LAPACK_TEST_DIR) LAPACK_TEST_DIR=${DATA} ;; ILP64) ILP64=${DATA} ;; - DTL) DTL=${DATA} ;; + DTL) DTL=${DATA} ;; + GCOV) GCOV=${DATA} ;; + AOCL_LAPACK_SUMMARY) AOCL_LAPACK_SUMMARY=${DATA} ;; *) esac done @@ -35,13 +42,14 @@ echo "BLAS_LIB_PATH = $BLAS_LIB_PATH" echo "BLAS_LIB = $BLAS_LIB" echo "LAPACK_LIB_PATH = $LAPACK_LIB_PATH" echo "LAPACK_LIB = $LAPACK_LIB" +echo "AOCLUTILS_LIB_PATH = $AOCLUTILS_LIB_PATH" echo "LAPACK_TEST_DIR = $LAPACK_TEST_DIR" echo echo echo "**********************************" echo -if [[ $BLAS_LIB_PATH == "" || $LAPACK_LIB_PATH == "" ]] +if [[ $BLAS_LIB_PATH == "" || $LAPACK_LIB_PATH == "" || $AOCLUTILS_LIB_PATH == "" ]] then echo "Error in calling script" echo "----------------------------------" @@ -49,12 +57,12 @@ then echo "Usage :" echo echo "$ sh run-netlib-test.sh BLAS_LIB_PATH= LAPACK_LIB_PATH= " - echo " [BLAS_LIB=] [ILP64=<0/1>] " - echo " [LAPACK_TEST_DIR=]" - echo + echo " AOCLUTILS_LIB_PATH= [BLAS_LIB=] " + echo " [ILP64=<0/1>] [LAPACK_TEST_DIR=]" + echo " [GCOV=<0/1>]" echo "[] indicates optional argument" echo - echo "Example: $ sh run-netlib-test.sh BLAS_LIB_PATH=\"/home/user/blis/lib\" LAPACK_LIB_PATH=\"/home/user/libflame/lib\" BLAS_LIB=\"libblis.a\" LAPACK_LIB=\"libflame.a\"" + echo "Example: $ sh run-netlib-test.sh BLAS_LIB_PATH=\"/home/user/blis/install/lib\" LAPACK_LIB_PATH=\"/home/user/libflame/install/lib\" AOCLUTILS_LIB_PATH=\"/home/user/aoclutils/install/lib\" BLAS_LIB=\"libblis.a\" LAPACK_LIB=\"libflame.a\"" echo echo "BLAS_LIB : blas library to use. Default=libblist-mt.a" echo "LAPACK_LIB : lapac library to use. Default=libflame.a" @@ -63,8 +71,11 @@ then echo "ILP64 : LP64 or ILP64 mode. Default=0(Use LP64)" echo "BLAS_LIB_PATH : path of blas library chosen in BLAS_LIB" echo "LAPACK_LIB_PATH : path to lapack library chosen in LAPACK_LIB" + echo "AOCLUTILS_LIB_PATH : path to aocl-utils library" echo "DTL_LIB_PATH : path to DTL library chosen in DTL_LIB (if DTL is enabled)" echo "LAPACK_TEST_DIR : netlib lapack test directory name. Default=lapack-3.10.0" + echo "GCOV : Enable(1) or disable(0) Code Coverage. Only Enable if Code Coverage is enabled on the library. Default=0" + echo "AOCL_LAPACK_SUMMARY : run aocl-lapack netlib test suite summary script. Default=1" echo exit 1 fi @@ -101,9 +112,9 @@ fi ulimit -s unlimited FORTRAN_FLAGS="gfortran -fopenmp" -TESTLAPACKLIB="$PWD/liblapack.a" +TESTLAPACKLIB="$PWD/liblapack.a $AOCLUTILS_LIB_PATH/$AOCLUTILS_LIB" -if [[ $ILP64 = "1" ]] +if [[ $ILP64 =~ ("1"|"ON") ]] then FORTRAN_FLAGS="gfortran -fopenmp -fdefault-integer-8" fi @@ -113,5 +124,16 @@ then TESTLAPACKLIB="$PWD/liblapack.a $PWD/libaocldtl.a -lpthread" fi -OMP_NUM_THREADS=1 make FC="$FORTRAN_FLAGS" LDFLAGS="-lstdc++ -lpthread -fopenmp" LAPACKLIB="$TESTLAPACKLIB" -j +if [[ $GCOV =~ ("1"|"ON") ]] +then + # echo "======>COVERAGE=1" + GCOV_FLAGS="-lgcov --coverage" +fi + +OMP_NUM_THREADS=1 make FC="$FORTRAN_FLAGS" LDFLAGS+="-lstdc++ -lpthread -fopenmp $GCOV_FLAGS" LAPACKLIB="$TESTLAPACKLIB" -j +if [[ $AOCL_LAPACK_SUMMARY = "1" ]] +then + cd ../ + python3 run-netlib-test-summary.py +fi diff --git a/script_aoclutil.sh b/script_aoclutil.sh index 3c323dd71..d78cb00c1 100644 --- a/script_aoclutil.sh +++ b/script_aoclutil.sh @@ -14,8 +14,16 @@ do DATA=$(echo $ARG | cut -f2 -d=) case "$VAR" in - LIBAOCLUTILS_GIT_TAG) LIBAOCLUTILS_GIT_TAG=${DATA} ;; - LIBAOCLUTILS_GIT_URL) LIBAOCLUTILS_GIT_URL=${DATA} ;; + LIBAOCLUTILS_GIT_TAG) if [[ ! -z "${DATA}" ]] + then + LIBAOCLUTILS_GIT_TAG=${DATA} + fi + ;; + LIBAOCLUTILS_GIT_URL) if [[ ! -z "${DATA}" ]] + then + LIBAOCLUTILS_GIT_URL=${DATA} + fi + ;; *) esac done diff --git a/so_version b/so_version index a7ff563cc..549d6b828 100644 --- a/so_version +++ b/so_version @@ -1,2 +1,2 @@ 4 -1.0 +2.0 diff --git a/src/base/flamec/blis/1/bl1_amax.c b/src/base/flamec/blis/1/bl1_amax.c index 655a9ed1d..c85f46bb8 100644 --- a/src/base/flamec/blis/1/bl1_amax.c +++ b/src/base/flamec/blis/1/bl1_amax.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_samax( integer n, float* x, integer incx, integer* index ) { diff --git a/src/base/flamec/blis/1/bl1_asum.c b/src/base/flamec/blis/1/bl1_asum.c index ad8fa3add..acc6ef091 100644 --- a/src/base/flamec/blis/1/bl1_asum.c +++ b/src/base/flamec/blis/1/bl1_asum.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sasum( integer n, float* x, integer incx, float* norm ) { diff --git a/src/base/flamec/blis/1/bl1_axpy.c b/src/base/flamec/blis/1/bl1_axpy.c index 932c96455..ceb0dd215 100644 --- a/src/base/flamec/blis/1/bl1_axpy.c +++ b/src/base/flamec/blis/1/bl1_axpy.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpy( integer n, float* alpha, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_axpymrt.c b/src/base/flamec/blis/1/bl1_axpymrt.c index 977688b1c..adca5a964 100644 --- a/src/base/flamec/blis/1/bl1_axpymrt.c +++ b/src/base/flamec/blis/1/bl1_axpymrt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpymrt( uplo1_t uplo, trans1_t trans, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_axpymt.c b/src/base/flamec/blis/1/bl1_axpymt.c index 1900ab986..67b7730c6 100644 --- a/src/base/flamec/blis/1/bl1_axpymt.c +++ b/src/base/flamec/blis/1/bl1_axpymt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpymt( trans1_t trans, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_axpysmt.c b/src/base/flamec/blis/1/bl1_axpysmt.c index ce993dc4f..54b7998a6 100644 --- a/src/base/flamec/blis/1/bl1_axpysmt.c +++ b/src/base/flamec/blis/1/bl1_axpysmt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpysmt( trans1_t trans, integer m, integer n, float* alpha0, float* alpha1, float* a, integer a_rs, integer a_cs, float* beta, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_axpysv.c b/src/base/flamec/blis/1/bl1_axpysv.c index 16c7c44ef..ea86c1990 100644 --- a/src/base/flamec/blis/1/bl1_axpysv.c +++ b/src/base/flamec/blis/1/bl1_axpysv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpysv( integer n, float* alpha0, float* alpha1, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_axpyv.c b/src/base/flamec/blis/1/bl1_axpyv.c index 13e8e9ae0..97f9c9548 100644 --- a/src/base/flamec/blis/1/bl1_axpyv.c +++ b/src/base/flamec/blis/1/bl1_axpyv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_saxpyv( conj1_t conj, integer n, float* alpha, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_conjm.c b/src/base/flamec/blis/1/bl1_conjm.c index 5e8c1af73..2e71a66cd 100644 --- a/src/base/flamec/blis/1/bl1_conjm.c +++ b/src/base/flamec/blis/1/bl1_conjm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sconjm( integer m, integer n, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/1/bl1_conjmr.c b/src/base/flamec/blis/1/bl1_conjmr.c index 2ec23f6d4..9afb9c496 100644 --- a/src/base/flamec/blis/1/bl1_conjmr.c +++ b/src/base/flamec/blis/1/bl1_conjmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sconjmr( uplo1_t uplo, integer m, integer n, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/1/bl1_conjv.c b/src/base/flamec/blis/1/bl1_conjv.c index dfa719a99..b3347a179 100644 --- a/src/base/flamec/blis/1/bl1_conjv.c +++ b/src/base/flamec/blis/1/bl1_conjv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sconjv( integer m, float* x, integer incx ) { diff --git a/src/base/flamec/blis/1/bl1_copy.c b/src/base/flamec/blis/1/bl1_copy.c index fef66442a..27e97edd0 100644 --- a/src/base/flamec/blis/1/bl1_copy.c +++ b/src/base/flamec/blis/1/bl1_copy.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_scopy( integer m, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_copymr.c b/src/base/flamec/blis/1/bl1_copymr.c index 5dd7181c3..bd7e62c6e 100644 --- a/src/base/flamec/blis/1/bl1_copymr.c +++ b/src/base/flamec/blis/1/bl1_copymr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_scopymr( uplo1_t uplo, integer m, integer n, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_copymrt.c b/src/base/flamec/blis/1/bl1_copymrt.c index 5f1e1cef6..f44a131b8 100644 --- a/src/base/flamec/blis/1/bl1_copymrt.c +++ b/src/base/flamec/blis/1/bl1_copymrt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_scopymrt( uplo1_t uplo, trans1_t trans, integer m, integer n, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_copymt.c b/src/base/flamec/blis/1/bl1_copymt.c index 760cd6027..52b776323 100644 --- a/src/base/flamec/blis/1/bl1_copymt.c +++ b/src/base/flamec/blis/1/bl1_copymt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_icopymt( trans1_t trans, integer m, integer n, integer* a, integer a_rs, integer a_cs, integer* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_copyv.c b/src/base/flamec/blis/1/bl1_copyv.c index b7c3dbaf6..8190aaed7 100644 --- a/src/base/flamec/blis/1/bl1_copyv.c +++ b/src/base/flamec/blis/1/bl1_copyv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_icopyv( conj1_t conj, integer m, integer* x, integer incx, integer* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_dot.c b/src/base/flamec/blis/1/bl1_dot.c index ac3477aab..78f0a00ce 100644 --- a/src/base/flamec/blis/1/bl1_dot.c +++ b/src/base/flamec/blis/1/bl1_dot.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sdot( conj1_t conj, integer n, float* x, integer incx, float* y, integer incy, float* rho ) { diff --git a/src/base/flamec/blis/1/bl1_dot2s.c b/src/base/flamec/blis/1/bl1_dot2s.c index f55d43a27..f35b3e3d6 100644 --- a/src/base/flamec/blis/1/bl1_dot2s.c +++ b/src/base/flamec/blis/1/bl1_dot2s.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sdot2s( conj1_t conj, integer n, float* alpha, float* x, integer incx, float* y, integer incy, float* beta, float* rho ) { diff --git a/src/base/flamec/blis/1/bl1_dots.c b/src/base/flamec/blis/1/bl1_dots.c index 213df7880..b866cfbf7 100644 --- a/src/base/flamec/blis/1/bl1_dots.c +++ b/src/base/flamec/blis/1/bl1_dots.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sdots( conj1_t conj, integer n, float* alpha, float* x, integer incx, float* y, integer incy, float* beta, float* rho ) { diff --git a/src/base/flamec/blis/1/bl1_fnorm.c b/src/base/flamec/blis/1/bl1_fnorm.c index 1c12703a5..ab80d44e3 100644 --- a/src/base/flamec/blis/1/bl1_fnorm.c +++ b/src/base/flamec/blis/1/bl1_fnorm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sfnorm( integer m, integer n, float* a, integer a_rs, integer a_cs, float* norm ) { diff --git a/src/base/flamec/blis/1/bl1_invscalm.c b/src/base/flamec/blis/1/bl1_invscalm.c index f6274b623..fd0ab53f6 100644 --- a/src/base/flamec/blis/1/bl1_invscalm.c +++ b/src/base/flamec/blis/1/bl1_invscalm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sinvscalm( conj1_t conj, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/1/bl1_invscalv.c b/src/base/flamec/blis/1/bl1_invscalv.c index 1ce7337b3..c82ab13e4 100644 --- a/src/base/flamec/blis/1/bl1_invscalv.c +++ b/src/base/flamec/blis/1/bl1_invscalv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sinvscalv( conj1_t conj, integer n, float* alpha, float* x, integer incx ) { diff --git a/src/base/flamec/blis/1/bl1_nrm2.c b/src/base/flamec/blis/1/bl1_nrm2.c index 8940a22e7..56dc1fbff 100644 --- a/src/base/flamec/blis/1/bl1_nrm2.c +++ b/src/base/flamec/blis/1/bl1_nrm2.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_snrm2( integer n, float* x, integer incx, float* norm ) { diff --git a/src/base/flamec/blis/1/bl1_scal.c b/src/base/flamec/blis/1/bl1_scal.c index 14c85acb1..e48f744b4 100644 --- a/src/base/flamec/blis/1/bl1_scal.c +++ b/src/base/flamec/blis/1/bl1_scal.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sscal( integer n, float* alpha, float* x, integer incx ) { diff --git a/src/base/flamec/blis/1/bl1_scalm.c b/src/base/flamec/blis/1/bl1_scalm.c index 635c9a85f..d2c83b079 100644 --- a/src/base/flamec/blis/1/bl1_scalm.c +++ b/src/base/flamec/blis/1/bl1_scalm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sscalm( conj1_t conj, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/1/bl1_scalmr.c b/src/base/flamec/blis/1/bl1_scalmr.c index 9872962f0..33cad9709 100644 --- a/src/base/flamec/blis/1/bl1_scalmr.c +++ b/src/base/flamec/blis/1/bl1_scalmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sscalmr( uplo1_t uplo, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/1/bl1_scalv.c b/src/base/flamec/blis/1/bl1_scalv.c index 30a2ccdcb..c16374000 100644 --- a/src/base/flamec/blis/1/bl1_scalv.c +++ b/src/base/flamec/blis/1/bl1_scalv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sscalv( conj1_t conj, integer n, float* alpha, float* x, integer incx ) { diff --git a/src/base/flamec/blis/1/bl1_swap.c b/src/base/flamec/blis/1/bl1_swap.c index ea7f67449..8558c12ca 100644 --- a/src/base/flamec/blis/1/bl1_swap.c +++ b/src/base/flamec/blis/1/bl1_swap.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sswap( integer n, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/1/bl1_swapmt.c b/src/base/flamec/blis/1/bl1_swapmt.c index d4d8dc093..8a0681d9e 100644 --- a/src/base/flamec/blis/1/bl1_swapmt.c +++ b/src/base/flamec/blis/1/bl1_swapmt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sswapmt( trans1_t trans, integer m, integer n, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/1/bl1_swapv.c b/src/base/flamec/blis/1/bl1_swapv.c index 13395de2c..415b49c71 100644 --- a/src/base/flamec/blis/1/bl1_swapv.c +++ b/src/base/flamec/blis/1/bl1_swapv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sswapv( integer n, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/2/bl1_gemv.c b/src/base/flamec/blis/2/bl1_gemv.c index 1597020b7..01c6c2e74 100644 --- a/src/base/flamec/blis/2/bl1_gemv.c +++ b/src/base/flamec/blis/2/bl1_gemv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sgemv( trans1_t transa, conj1_t conjx, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/2/bl1_ger.c b/src/base/flamec/blis/2/bl1_ger.c index 7879845e9..a15e3f072 100644 --- a/src/base/flamec/blis/2/bl1_ger.c +++ b/src/base/flamec/blis/2/bl1_ger.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sger( conj1_t conjx, conj1_t conjy, integer m, integer n, float* alpha, float* x, integer incx, float* y, integer incy, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/2/bl1_hemv.c b/src/base/flamec/blis/2/bl1_hemv.c index df168c093..0f7638b9d 100644 --- a/src/base/flamec/blis/2/bl1_hemv.c +++ b/src/base/flamec/blis/2/bl1_hemv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_shemv( uplo1_t uplo, conj1_t conj, integer m, float* alpha, float* a, integer a_rs, integer a_cs, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/2/bl1_her.c b/src/base/flamec/blis/2/bl1_her.c index 0a0ba1faf..226d4db54 100644 --- a/src/base/flamec/blis/2/bl1_her.c +++ b/src/base/flamec/blis/2/bl1_her.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sher( uplo1_t uplo, conj1_t conj, integer m, float* alpha, float* x, integer incx, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/2/bl1_her2.c b/src/base/flamec/blis/2/bl1_her2.c index aff600594..1a6985402 100644 --- a/src/base/flamec/blis/2/bl1_her2.c +++ b/src/base/flamec/blis/2/bl1_her2.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sher2( uplo1_t uplo, conj1_t conj, integer m, float* alpha, float* x, integer incx, float* y, integer incy, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/2/bl1_symv.c b/src/base/flamec/blis/2/bl1_symv.c index a1f0237ab..42b09e3f9 100644 --- a/src/base/flamec/blis/2/bl1_symv.c +++ b/src/base/flamec/blis/2/bl1_symv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssymv( uplo1_t uplo, integer m, float* alpha, float* a, integer a_rs, integer a_cs, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/2/bl1_syr.c b/src/base/flamec/blis/2/bl1_syr.c index faf2283da..6835fa6de 100644 --- a/src/base/flamec/blis/2/bl1_syr.c +++ b/src/base/flamec/blis/2/bl1_syr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssyr( uplo1_t uplo, integer m, float* alpha, float* x, integer incx, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/2/bl1_syr2.c b/src/base/flamec/blis/2/bl1_syr2.c index 5d71a7a9b..c03a3e5d1 100644 --- a/src/base/flamec/blis/2/bl1_syr2.c +++ b/src/base/flamec/blis/2/bl1_syr2.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssyr2( uplo1_t uplo, integer m, float* alpha, float* x, integer incx, float* y, integer incy, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/2/bl1_trmv.c b/src/base/flamec/blis/2/bl1_trmv.c index 0b7faae72..e8745503b 100644 --- a/src/base/flamec/blis/2/bl1_trmv.c +++ b/src/base/flamec/blis/2/bl1_trmv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strmv( uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, float* a, integer a_rs, integer a_cs, float* x, integer incx ) { diff --git a/src/base/flamec/blis/2/bl1_trmvsx.c b/src/base/flamec/blis/2/bl1_trmvsx.c index b9938566a..c137ed678 100644 --- a/src/base/flamec/blis/2/bl1_trmvsx.c +++ b/src/base/flamec/blis/2/bl1_trmvsx.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strmvsx( uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, float* alpha, float* a, integer a_rs, integer a_cs, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/2/bl1_trsv.c b/src/base/flamec/blis/2/bl1_trsv.c index c7a54e551..19e1e6cc1 100644 --- a/src/base/flamec/blis/2/bl1_trsv.c +++ b/src/base/flamec/blis/2/bl1_trsv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strsv( uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, float* a, integer a_rs, integer a_cs, float* x, integer incx ) { diff --git a/src/base/flamec/blis/2/bl1_trsvsx.c b/src/base/flamec/blis/2/bl1_trsvsx.c index 444a7b3a5..5b5168071 100644 --- a/src/base/flamec/blis/2/bl1_trsvsx.c +++ b/src/base/flamec/blis/2/bl1_trsvsx.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strsvsx( uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, float* alpha, float* a, integer a_rs, integer a_cs, float* x, integer incx, float* beta, float* y, integer incy ) { diff --git a/src/base/flamec/blis/3/bl1_gemm.c b/src/base/flamec/blis/3/bl1_gemm.c index 4edc5e455..49a8917eb 100644 --- a/src/base/flamec/blis/3/bl1_gemm.c +++ b/src/base/flamec/blis/3/bl1_gemm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sgemm( trans1_t transa, trans1_t transb, integer m, integer k, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_hemm.c b/src/base/flamec/blis/3/bl1_hemm.c index bf42ecf44..91513b6a8 100644 --- a/src/base/flamec/blis/3/bl1_hemm.c +++ b/src/base/flamec/blis/3/bl1_hemm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_shemm( side1_t side, uplo1_t uplo, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_her2k.c b/src/base/flamec/blis/3/bl1_her2k.c index 74df3c4c9..6453cbfa7 100644 --- a/src/base/flamec/blis/3/bl1_her2k.c +++ b/src/base/flamec/blis/3/bl1_her2k.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sher2k( uplo1_t uplo, trans1_t trans, integer m, integer k, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_herk.c b/src/base/flamec/blis/3/bl1_herk.c index 699cd3172..6509e4eba 100644 --- a/src/base/flamec/blis/3/bl1_herk.c +++ b/src/base/flamec/blis/3/bl1_herk.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sherk( uplo1_t uplo, trans1_t trans, integer m, integer k, float* alpha, float* a, integer a_rs, integer a_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_symm.c b/src/base/flamec/blis/3/bl1_symm.c index 3f7ffd23c..a6e86c680 100644 --- a/src/base/flamec/blis/3/bl1_symm.c +++ b/src/base/flamec/blis/3/bl1_symm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssymm( side1_t side, uplo1_t uplo, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_syr2k.c b/src/base/flamec/blis/3/bl1_syr2k.c index c9fd45709..77ef9cc1a 100644 --- a/src/base/flamec/blis/3/bl1_syr2k.c +++ b/src/base/flamec/blis/3/bl1_syr2k.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssyr2k( uplo1_t uplo, trans1_t trans, integer m, integer k, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_syrk.c b/src/base/flamec/blis/3/bl1_syrk.c index fc503d107..981129c00 100644 --- a/src/base/flamec/blis/3/bl1_syrk.c +++ b/src/base/flamec/blis/3/bl1_syrk.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssyrk( uplo1_t uplo, trans1_t trans, integer m, integer k, float* alpha, float* a, integer a_rs, integer a_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_trmm.c b/src/base/flamec/blis/3/bl1_trmm.c index 5f4022ac7..5bcefac7f 100644 --- a/src/base/flamec/blis/3/bl1_trmm.c +++ b/src/base/flamec/blis/3/bl1_trmm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strmm( side1_t side, uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/3/bl1_trmmsx.c b/src/base/flamec/blis/3/bl1_trmmsx.c index 50b37004b..c17192a0d 100644 --- a/src/base/flamec/blis/3/bl1_trmmsx.c +++ b/src/base/flamec/blis/3/bl1_trmmsx.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strmmsx( side1_t side, uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/3/bl1_trsm.c b/src/base/flamec/blis/3/bl1_trsm.c index 7eded1d15..aa4b18b4b 100644 --- a/src/base/flamec/blis/3/bl1_trsm.c +++ b/src/base/flamec/blis/3/bl1_trsm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strsm( side1_t side, uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/3/bl1_trsmsx.c b/src/base/flamec/blis/3/bl1_trsmsx.c index bbda9256a..cd0ebf71d 100644 --- a/src/base/flamec/blis/3/bl1_trsmsx.c +++ b/src/base/flamec/blis/3/bl1_trsmsx.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_strsmsx( side1_t side, uplo1_t uplo, trans1_t trans, diag1_t diag, integer m, integer n, float* alpha, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs, float* beta, float* c, integer c_rs, integer c_cs ) { diff --git a/src/base/flamec/blis/fused/bl1_axpyv2bdotaxpy.c b/src/base/flamec/blis/fused/bl1_axpyv2bdotaxpy.c index d700551d3..7c75b9cf5 100644 --- a/src/base/flamec/blis/fused/bl1_axpyv2bdotaxpy.c +++ b/src/base/flamec/blis/fused/bl1_axpyv2bdotaxpy.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Effective computation: diff --git a/src/base/flamec/blis/fused/bl1_dotaxpy.c b/src/base/flamec/blis/fused/bl1_dotaxpy.c index 35a0a307e..e49c821e9 100644 --- a/src/base/flamec/blis/fused/bl1_dotaxpy.c +++ b/src/base/flamec/blis/fused/bl1_dotaxpy.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Effective computation: diff --git a/src/base/flamec/blis/fused/bl1_dotsv2.c b/src/base/flamec/blis/fused/bl1_dotsv2.c index f598a7332..5a12a1e66 100644 --- a/src/base/flamec/blis/fused/bl1_dotsv2.c +++ b/src/base/flamec/blis/fused/bl1_dotsv2.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Effective computation: diff --git a/src/base/flamec/blis/fused/bl1_dotsv3.c b/src/base/flamec/blis/fused/bl1_dotsv3.c index 511a5a195..8c3c80fd3 100644 --- a/src/base/flamec/blis/fused/bl1_dotsv3.c +++ b/src/base/flamec/blis/fused/bl1_dotsv3.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Effective computation: diff --git a/src/base/flamec/blis/fused/bl1_dotv2axpyv2b.c b/src/base/flamec/blis/fused/bl1_dotv2axpyv2b.c index ab92b64e6..57c69931a 100644 --- a/src/base/flamec/blis/fused/bl1_dotv2axpyv2b.c +++ b/src/base/flamec/blis/fused/bl1_dotv2axpyv2b.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Effective computation: diff --git a/src/base/flamec/blis/include/blis_macro_defs.h b/src/base/flamec/blis/include/blis_macro_defs.h index 1e5e22611..e7152c088 100644 --- a/src/base/flamec/blis/include/blis_macro_defs.h +++ b/src/base/flamec/blis/include/blis_macro_defs.h @@ -142,18 +142,20 @@ else { *(alpha) = ( double ) sqrt( *(alpha) ); *(error) = FLA_SUCCESS; } // void bl1_csqrte( scomplex* alpha, int* error ); #define bl1_csqrte( alpha, error ) \ if ( (alpha)->real <= 0.0F || isnan( (alpha)->real) ) \ -{ *(error) = FLA_FAILURE; } \ +{ (alpha)->imag = 0.0F; *(error) = FLA_FAILURE; } \ else { \ -(alpha)->real = ( float ) sqrt( (alpha)->real ); \ -(alpha)->imag = 0.0F; *(error) = FLA_SUCCESS; } + (alpha)->real = ( float ) sqrt( (alpha)->real ); \ + (alpha)->imag = 0.0F; *(error) = FLA_SUCCESS; \ +} // void bl1_zsqrte( dcomplex* alpha, int* error ); #define bl1_zsqrte( alpha, error ) \ if ( (alpha)->real <= 0.0 || isnan( (alpha)->real) ) \ -{ *(error) = FLA_FAILURE; } \ +{ (alpha)->imag = 0.0; *(error) = FLA_FAILURE; } \ else { \ -(alpha)->real = ( double ) sqrt( (alpha)->real ); \ -(alpha)->imag = 0.0; *(error) = FLA_SUCCESS; } + (alpha)->real = ( double ) sqrt( (alpha)->real ); \ + (alpha)->imag = 0.0; *(error) = FLA_SUCCESS; \ +} // --- absval2 --- diff --git a/src/base/flamec/blis/misc/bl1_abort.c b/src/base/flamec/blis/misc/bl1_abort.c index 800e2bfde..51585f055 100644 --- a/src/base/flamec/blis/misc/bl1_abort.c +++ b/src/base/flamec/blis/misc/bl1_abort.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_abort( void ) { diff --git a/src/base/flamec/blis/misc/bl1_param_map.c b/src/base/flamec/blis/misc/bl1_param_map.c index 3c5c9848e..fea2de9c5 100644 --- a/src/base/flamec/blis/misc/bl1_param_map.c +++ b/src/base/flamec/blis/misc/bl1_param_map.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif // --- BLIS to BLAS/LAPACK mappings -------------------------------------------- diff --git a/src/base/flamec/blis/query/bl1_check.c b/src/base/flamec/blis/query/bl1_check.c index 4fbc53a6c..416e2f3c6 100644 --- a/src/base/flamec/blis/query/bl1_check.c +++ b/src/base/flamec/blis/query/bl1_check.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif // --- storage-related --------------------------------------------------------- diff --git a/src/base/flamec/blis/query/bl1_does.c b/src/base/flamec/blis/query/bl1_does.c index ebb66181b..360a040ee 100644 --- a/src/base/flamec/blis/query/bl1_does.c +++ b/src/base/flamec/blis/query/bl1_does.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif int bl1_does_trans( trans1_t trans ) { diff --git a/src/base/flamec/blis/query/bl1_is.c b/src/base/flamec/blis/query/bl1_is.c index 755902b86..377e9369a 100644 --- a/src/base/flamec/blis/query/bl1_is.c +++ b/src/base/flamec/blis/query/bl1_is.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif // --- trans ------------------------------------------------------------------- diff --git a/src/base/flamec/blis/query/bl1_proj.c b/src/base/flamec/blis/query/bl1_proj.c index c3faac3d3..2f807d317 100644 --- a/src/base/flamec/blis/query/bl1_proj.c +++ b/src/base/flamec/blis/query/bl1_proj.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif conj1_t bl1_proj_trans1_to_conj( trans1_t trans ) { diff --git a/src/base/flamec/blis/query/bl1_vector.c b/src/base/flamec/blis/query/bl1_vector.c index 4e35e76a0..3cd43a374 100644 --- a/src/base/flamec/blis/query/bl1_vector.c +++ b/src/base/flamec/blis/query/bl1_vector.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif int bl1_vector_dim( integer m, integer n ) { diff --git a/src/base/flamec/blis/util/bl1_allocm.c b/src/base/flamec/blis/util/bl1_allocm.c index ffd20a476..813ff4612 100644 --- a/src/base/flamec/blis/util/bl1_allocm.c +++ b/src/base/flamec/blis/util/bl1_allocm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #ifdef BLIS1_ENABLE_USE_OF_FLA_MALLOC #include "FLAME.h" diff --git a/src/base/flamec/blis/util/bl1_allocv.c b/src/base/flamec/blis/util/bl1_allocv.c index 9270582df..8f67d8749 100644 --- a/src/base/flamec/blis/util/bl1_allocv.c +++ b/src/base/flamec/blis/util/bl1_allocv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #ifdef BLIS1_ENABLE_USE_OF_FLA_MALLOC #include "FLAME.h" diff --git a/src/base/flamec/blis/util/bl1_apdiagmv.c b/src/base/flamec/blis/util/bl1_apdiagmv.c index 570ba9b88..5299e3138 100644 --- a/src/base/flamec/blis/util/bl1_apdiagmv.c +++ b/src/base/flamec/blis/util/bl1_apdiagmv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sapdiagmv( side1_t side, conj1_t conj, integer m, integer n, float* x, integer incx, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_constants.c b/src/base/flamec/blis/util/bl1_constants.c index 22b96f5d1..8d185cfd9 100644 --- a/src/base/flamec/blis/util/bl1_constants.c +++ b/src/base/flamec/blis/util/bl1_constants.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif // --- two --- diff --git a/src/base/flamec/blis/util/bl1_create_contigm.c b/src/base/flamec/blis/util/bl1_create_contigm.c index 97459ac72..0d3c2ef4f 100644 --- a/src/base/flamec/blis/util/bl1_create_contigm.c +++ b/src/base/flamec/blis/util/bl1_create_contigm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_screate_contigm( integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_create_contigmr.c b/src/base/flamec/blis/util/bl1_create_contigmr.c index a2259e1c7..1322335a2 100644 --- a/src/base/flamec/blis/util/bl1_create_contigmr.c +++ b/src/base/flamec/blis/util/bl1_create_contigmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_screate_contigmr( uplo1_t uplo, integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_create_contigmsr.c b/src/base/flamec/blis/util/bl1_create_contigmsr.c index aff9794b1..caa75ed45 100644 --- a/src/base/flamec/blis/util/bl1_create_contigmsr.c +++ b/src/base/flamec/blis/util/bl1_create_contigmsr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_screate_contigmsr( side1_t side, uplo1_t uplo, integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_create_contigmt.c b/src/base/flamec/blis/util/bl1_create_contigmt.c index 7c23595e6..22fdfc6e9 100644 --- a/src/base/flamec/blis/util/bl1_create_contigmt.c +++ b/src/base/flamec/blis/util/bl1_create_contigmt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_screate_contigmt( trans1_t trans_dims, integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_ewinvscalmt.c b/src/base/flamec/blis/util/bl1_ewinvscalmt.c index 966599ac5..64ab78a41 100644 --- a/src/base/flamec/blis/util/bl1_ewinvscalmt.c +++ b/src/base/flamec/blis/util/bl1_ewinvscalmt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sewinvscalmt( trans1_t trans, integer m, integer n, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/util/bl1_ewinvscalv.c b/src/base/flamec/blis/util/bl1_ewinvscalv.c index b72e0ee0e..05e0aeb50 100644 --- a/src/base/flamec/blis/util/bl1_ewinvscalv.c +++ b/src/base/flamec/blis/util/bl1_ewinvscalv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sewinvscalv( conj1_t conj, integer n, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/util/bl1_ewscalmt.c b/src/base/flamec/blis/util/bl1_ewscalmt.c index 5466562d5..5d259bcda 100644 --- a/src/base/flamec/blis/util/bl1_ewscalmt.c +++ b/src/base/flamec/blis/util/bl1_ewscalmt.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sewscalmt( trans1_t trans, integer m, integer n, float* a, integer a_rs, integer a_cs, float* b, integer b_rs, integer b_cs ) { diff --git a/src/base/flamec/blis/util/bl1_ewscalv.c b/src/base/flamec/blis/util/bl1_ewscalv.c index 3a95d3f82..09e4fa6ff 100644 --- a/src/base/flamec/blis/util/bl1_ewscalv.c +++ b/src/base/flamec/blis/util/bl1_ewscalv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sewscalv( conj1_t conj, integer n, float* x, integer incx, float* y, integer incy ) { diff --git a/src/base/flamec/blis/util/bl1_free.c b/src/base/flamec/blis/util/bl1_free.c index a434575c6..1b6b82219 100644 --- a/src/base/flamec/blis/util/bl1_free.c +++ b/src/base/flamec/blis/util/bl1_free.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #ifdef BLIS1_ENABLE_USE_OF_FLA_MALLOC #include "FLAME.h" diff --git a/src/base/flamec/blis/util/bl1_free_contigm.c b/src/base/flamec/blis/util/bl1_free_contigm.c index 0135b0201..ffeca5697 100644 --- a/src/base/flamec/blis/util/bl1_free_contigm.c +++ b/src/base/flamec/blis/util/bl1_free_contigm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sfree_contigm( float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_free_saved_contigm.c b/src/base/flamec/blis/util/bl1_free_saved_contigm.c index 3734b08ad..c3dbb738c 100644 --- a/src/base/flamec/blis/util/bl1_free_saved_contigm.c +++ b/src/base/flamec/blis/util/bl1_free_saved_contigm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sfree_saved_contigm( integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_free_saved_contigmr.c b/src/base/flamec/blis/util/bl1_free_saved_contigmr.c index 1a4c5052b..317d0aca0 100644 --- a/src/base/flamec/blis/util/bl1_free_saved_contigmr.c +++ b/src/base/flamec/blis/util/bl1_free_saved_contigmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sfree_saved_contigmr( uplo1_t uplo, integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_free_saved_contigmsr.c b/src/base/flamec/blis/util/bl1_free_saved_contigmsr.c index 3186f4362..dc7d73482 100644 --- a/src/base/flamec/blis/util/bl1_free_saved_contigmsr.c +++ b/src/base/flamec/blis/util/bl1_free_saved_contigmsr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sfree_saved_contigmsr( side1_t side, uplo1_t uplo, integer m, integer n, float* a_save, integer a_rs_save, integer a_cs_save, float** a, integer* a_rs, integer* a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_ident.c b/src/base/flamec/blis/util/bl1_ident.c index 586661862..1addb321f 100644 --- a/src/base/flamec/blis/util/bl1_ident.c +++ b/src/base/flamec/blis/util/bl1_ident.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sident( integer m, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_invert2s.c b/src/base/flamec/blis/util/bl1_invert2s.c index 6c049b1bd..f9504ccc3 100644 --- a/src/base/flamec/blis/util/bl1_invert2s.c +++ b/src/base/flamec/blis/util/bl1_invert2s.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sinvert2s( conj1_t conj, float* alpha, float* beta ) { diff --git a/src/base/flamec/blis/util/bl1_inverts.c b/src/base/flamec/blis/util/bl1_inverts.c index 6a7300b7b..49dcc40dc 100644 --- a/src/base/flamec/blis/util/bl1_inverts.c +++ b/src/base/flamec/blis/util/bl1_inverts.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sinverts( conj1_t conj, float* alpha ) { diff --git a/src/base/flamec/blis/util/bl1_invertv.c b/src/base/flamec/blis/util/bl1_invertv.c index 0367688dc..568f0c127 100644 --- a/src/base/flamec/blis/util/bl1_invertv.c +++ b/src/base/flamec/blis/util/bl1_invertv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sinvertv( conj1_t conj, integer n, float* x, integer incx ) { diff --git a/src/base/flamec/blis/util/bl1_maxabsm.c b/src/base/flamec/blis/util/bl1_maxabsm.c index f11c1e184..0ee79fe5d 100644 --- a/src/base/flamec/blis/util/bl1_maxabsm.c +++ b/src/base/flamec/blis/util/bl1_maxabsm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_smaxabsm( integer m, integer n, float* a, integer a_rs, integer a_cs, float* maxabs ) { diff --git a/src/base/flamec/blis/util/bl1_maxabsmr.c b/src/base/flamec/blis/util/bl1_maxabsmr.c index 66a287637..76c10f3b6 100644 --- a/src/base/flamec/blis/util/bl1_maxabsmr.c +++ b/src/base/flamec/blis/util/bl1_maxabsmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_smaxabsmr( uplo1_t uplo, integer m, integer n, float* a, integer a_rs, integer a_cs, float* maxabs ) { diff --git a/src/base/flamec/blis/util/bl1_maxabsv.c b/src/base/flamec/blis/util/bl1_maxabsv.c index 83c48dd49..b059ea49a 100644 --- a/src/base/flamec/blis/util/bl1_maxabsv.c +++ b/src/base/flamec/blis/util/bl1_maxabsv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_smaxabsv( integer n, float* x, integer incx, float* maxabs ) { diff --git a/src/base/flamec/blis/util/bl1_randm.c b/src/base/flamec/blis/util/bl1_randm.c index d50343418..993d9bd52 100644 --- a/src/base/flamec/blis/util/bl1_randm.c +++ b/src/base/flamec/blis/util/bl1_randm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_srandm( integer m, integer n, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_randmr.c b/src/base/flamec/blis/util/bl1_randmr.c index 55dfd88b7..9e3329e43 100644 --- a/src/base/flamec/blis/util/bl1_randmr.c +++ b/src/base/flamec/blis/util/bl1_randmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_srandmr( uplo1_t uplo, diag1_t diag, integer m, integer n, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_rands.c b/src/base/flamec/blis/util/bl1_rands.c index 668a53887..442006444 100644 --- a/src/base/flamec/blis/util/bl1_rands.c +++ b/src/base/flamec/blis/util/bl1_rands.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_srands( float* alpha ) { diff --git a/src/base/flamec/blis/util/bl1_randv.c b/src/base/flamec/blis/util/bl1_randv.c index d2752fb1f..6300ec3ba 100644 --- a/src/base/flamec/blis/util/bl1_randv.c +++ b/src/base/flamec/blis/util/bl1_randv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_srandv( integer n, float* x, integer incx ) { diff --git a/src/base/flamec/blis/util/bl1_scalediag.c b/src/base/flamec/blis/util/bl1_scalediag.c index 203d99334..44690dd64 100644 --- a/src/base/flamec/blis/util/bl1_scalediag.c +++ b/src/base/flamec/blis/util/bl1_scalediag.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sscalediag( conj1_t conj, integer offset, integer m, integer n, float* sigma, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_set_contig_strides.c b/src/base/flamec/blis/util/bl1_set_contig_strides.c index 508ae07b0..8c71bfeba 100644 --- a/src/base/flamec/blis/util/bl1_set_contig_strides.c +++ b/src/base/flamec/blis/util/bl1_set_contig_strides.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_set_contig_strides( integer m, integer n, integer* rs, integer* cs ) { diff --git a/src/base/flamec/blis/util/bl1_set_dims.c b/src/base/flamec/blis/util/bl1_set_dims.c index 790a07f3a..56e19063b 100644 --- a/src/base/flamec/blis/util/bl1_set_dims.c +++ b/src/base/flamec/blis/util/bl1_set_dims.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_set_dims_with_trans( trans1_t trans, integer m, integer n, integer* m_new, integer* n_new ) { diff --git a/src/base/flamec/blis/util/bl1_setdiag.c b/src/base/flamec/blis/util/bl1_setdiag.c index 0b719a0e4..4ecfe0538 100644 --- a/src/base/flamec/blis/util/bl1_setdiag.c +++ b/src/base/flamec/blis/util/bl1_setdiag.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_isetdiag( integer offset, integer m, integer n, integer* sigma, integer* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_setm.c b/src/base/flamec/blis/util/bl1_setm.c index 9c273096c..b577337a8 100644 --- a/src/base/flamec/blis/util/bl1_setm.c +++ b/src/base/flamec/blis/util/bl1_setm.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_isetm( integer m, integer n, integer* sigma, integer* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_setmr.c b/src/base/flamec/blis/util/bl1_setmr.c index 2254b7ce7..86fda14b2 100644 --- a/src/base/flamec/blis/util/bl1_setmr.c +++ b/src/base/flamec/blis/util/bl1_setmr.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssetmr( uplo1_t uplo, integer m, integer n, float* sigma, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_setv.c b/src/base/flamec/blis/util/bl1_setv.c index af875c6dc..c5bd053d1 100644 --- a/src/base/flamec/blis/util/bl1_setv.c +++ b/src/base/flamec/blis/util/bl1_setv.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_isetv( integer n, integer* sigma, integer* x, integer incx ) { diff --git a/src/base/flamec/blis/util/bl1_shiftdiag.c b/src/base/flamec/blis/util/bl1_shiftdiag.c index 4a9f2f139..05928216e 100644 --- a/src/base/flamec/blis/util/bl1_shiftdiag.c +++ b/src/base/flamec/blis/util/bl1_shiftdiag.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_sshiftdiag( conj1_t conj, integer offset, integer m, integer n, float* sigma, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/blis/util/bl1_symmize.c b/src/base/flamec/blis/util/bl1_symmize.c index 20237cf4e..c6fda2044 100644 --- a/src/base/flamec/blis/util/bl1_symmize.c +++ b/src/base/flamec/blis/util/bl1_symmize.c @@ -8,7 +8,13 @@ */ +/* +* Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ #include "blis1.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif void bl1_ssymmize( conj1_t conj, uplo1_t uplo, integer m, float* a, integer a_rs, integer a_cs ) { diff --git a/src/base/flamec/include/FLA_Context.h b/src/base/flamec/include/FLA_Context.h index e31f7f938..0e5af32dc 100644 --- a/src/base/flamec/include/FLA_Context.h +++ b/src/base/flamec/include/FLA_Context.h @@ -1,5 +1,5 @@ /* ************************************************************************ - * Copyright (c) 2022 Advanced Micro Devices, Inc. + * Copyright (c) 2022-2023 Advanced Micro Devices, Inc. All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal @@ -101,10 +101,35 @@ typedef struct _fla_context FLA_Bool is_fma; FLA_Bool is_avx2; FLA_Bool is_avx512; + FLA_Bool libflame_mt; // num_threads is set using libFLAME environment variable or using OpenMP. } fla_context; +#define FLA_CONTEXT_INITIALIZER \ + { \ + .num_threads = -1, \ + .is_fma = FALSE, \ + .is_avx2 = FALSE, \ + .is_avx512 = FALSE, \ + .libflame_mt = FALSE, \ + } + extern fla_context global_context; +typedef struct _fla_tl_context +{ + // num of threads + int num_threads; + FLA_Bool libflame_mt; // num_threads is set using libFLAME environment variable or using OpenMP. +} fla_tl_context; + +#define FLA_TL_CONTEXT_INITIALIZER \ + { \ + .num_threads = -1, \ + .libflame_mt = FALSE, \ + } + +extern TLS_CLASS_SPEC fla_tl_context tl_context; + /*! \ingroup aux_module * \brief Initialise various framework variables including * 1.context diff --git a/src/base/flamec/include/FLA_f2c.h b/src/base/flamec/include/FLA_f2c.h index cc0a736a6..89a78ea74 100644 --- a/src/base/flamec/include/FLA_f2c.h +++ b/src/base/flamec/include/FLA_f2c.h @@ -163,7 +163,7 @@ typedef unsigned __int64 uint64_t; typedef int64_t integer; typedef uint64_t uinteger; #else -typedef int integer; +typedef int32_t integer; typedef unsigned long int uinteger; #endif @@ -203,11 +203,7 @@ typedef short ftnlen; typedef short ftnint; #else typedef long int flag; - #ifndef BLIS1_FROM_LIBFLAME - #define ftnlen integer - #else - typedef long int ftnlen; - #endif +typedef integer ftnlen; typedef long int ftnint; #endif @@ -354,6 +350,14 @@ typedef doublereal (*E_fp)(...); typedef /* Complex */ VOID (*C_fp)(...); typedef /* Double Complex */ VOID (*Z_fp)(...); typedef logical (*L_fp)(...); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(doublecomplex *); +typedef logical (*L_fpz2)(doublecomplex *, doublecomplex *); typedef shortlogical (*K_fp)(...); typedef /* Character */ VOID (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); @@ -367,6 +371,14 @@ typedef doublereal (*E_fp)(); typedef /* Complex */ VOID (*C_fp)(); typedef /* Double Complex */ VOID (*Z_fp)(); typedef logical (*L_fp)(); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(doublecomplex *); +typedef logical (*L_fpz2)(doublecomplex *, doublecomplex *); typedef shortlogical (*K_fp)(); typedef /* Character */ VOID (*H_fp)(); typedef /* Subroutine */ int (*S_fp)(); diff --git a/src/base/flamec/include/FLA_lapack_f77_prototypes.h b/src/base/flamec/include/FLA_lapack_f77_prototypes.h index c5e505f7c..f3317c5d4 100644 --- a/src/base/flamec/include/FLA_lapack_f77_prototypes.h +++ b/src/base/flamec/include/FLA_lapack_f77_prototypes.h @@ -2109,9 +2109,9 @@ #define F77_dormhr F77_FUNC( dormhr, DORMHR ) // Function Prototypes declaration -int F77_cgelst(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info); -int F77_clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); -int F77_ctrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, complex *a, integer *lda, complex *b, integer *ldb, complex *c__, integer *ldc, real *scale, real *swork, integer * ldswork, integer *info); +int F77_cgelst(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info); +int F77_clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); +int F77_ctrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *c__, integer *ldc, real *scale, real *swork, integer * ldswork, integer *info); int F77_dgelst(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *work, integer *lwork, integer *info); doublereal F77_dlarmm(doublereal *anorm, doublereal *bnorm, doublereal *cnorm); int F77_dlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); @@ -2120,9 +2120,9 @@ int F77_sgelst(char *trans, integer *m, integer *n, integer * nrhs, real *a, int real F77_slarmm(real *anorm, real *bnorm, real *cnorm); int F77_slatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, real *a, integer *lda, real *x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); int F77_strsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, real *a, integer *lda, real *b, integer *ldb, real *c__, integer *ldc, real *scale, integer *iwork, integer *liwork, real *swork, integer *ldswork, integer *info); -int F77_zgelst(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info); -int F77_zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); -int F77_ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); +int F77_zgelst(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info); +int F77_zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); +int F77_ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); double F77_dlamch(char* cmach); double F77_dlamc3(double* a, double* b); doublereal F77_dladiv2(doublereal* a, doublereal* b, doublereal* c__, doublereal* d__, doublereal* r__, doublereal* t); diff --git a/src/base/flamec/include/FLA_lapack_var_prototypes.h b/src/base/flamec/include/FLA_lapack_var_prototypes.h index 503f4cb02..79bd7ca12 100644 --- a/src/base/flamec/include/FLA_lapack_var_prototypes.h +++ b/src/base/flamec/include/FLA_lapack_var_prototypes.h @@ -47,10 +47,6 @@ #include "FLA_UDdate_UT.h" #include "FLA_UDdate_UT_inc.h" -// SIMD Optimized kernels -#include "fla_lapack_x86_common.h" -#include "fla_lapack_avx2_kernels.h" - // BLAS kernels #include "fla_lapack_fblas_common.h" #include "fla_lapack_fblas_kernels.h" diff --git a/src/base/flamec/include/FLA_macro_defs.h b/src/base/flamec/include/FLA_macro_defs.h index e29117893..c911ab190 100644 --- a/src/base/flamec/include/FLA_macro_defs.h +++ b/src/base/flamec/include/FLA_macro_defs.h @@ -9,7 +9,7 @@ */ /* - Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ @@ -21,10 +21,6 @@ #undef NULL #define NULL 0 -/* Enable AMD specific optimizations */ -#ifdef FLA_ENABLE_AMD_OPT -#define FLA_AMD_OPT 1 -#endif #ifdef FLA_ENABLE_WINDOWS_BUILD #define restrict __restrict #endif @@ -258,10 +254,11 @@ #define FLA_SGETRF_SMALL_THRESH1 (117) #define FLA_SGETRF_MEDIUM_THRESH0 (480) -#define FLA_DGETRF_SMALL_THRESH0 (81) +#define FLA_DGETRF_SMALL_THRESH0 (8) +#define FLA_DGETRF_SMALL_AVX2_THRESH0 (81) +#define FLA_DGETRF_SMALL_AVX512_THRESH0 (160) -#define FLA_ZGETRF_SMALL_THRESH0 (22) -#define FLA_ZGETRF_SMALL_THRESH1 (50) +#define FLA_ZGETRF_SMALL_THRESH (100) // GETRFNPI , these thresholds are used to chose between 3 algorithms to get best // results in terms of perfmormance diff --git a/src/base/flamec/include/FLA_progress.h b/src/base/flamec/include/FLA_progress.h index b485f973a..0779db26d 100644 --- a/src/base/flamec/include/FLA_progress.h +++ b/src/base/flamec/include/FLA_progress.h @@ -38,7 +38,7 @@ const integer* const total_threads ); void aocl_fla_set_progress(aocl_fla_progress_callback func); -extern aocl_fla_progress_callback aocl_fla_progress_ptr; +extern volatile aocl_fla_progress_callback aocl_fla_progress_glb_ptr; #ifndef FLA_ENABLE_WINDOWS_BUILD __attribute__((weak)) int aocl_fla_progress( @@ -56,16 +56,24 @@ const integer* const total_threads exit(0);\ }\ +#if FLA_OPENMP_MULTITHREADING + #define AOCL_FLA_PROGRESS_VAR \ - static TLS_CLASS_SPEC integer step_count=0;\ - static TLS_CLASS_SPEC integer size=0;\ - static TLS_CLASS_SPEC integer thread_id = 0;\ - static TLS_CLASS_SPEC integer total_threads = 1;\ - if(aocl_fla_progress_ptr)\ - {\ - /* Current implementation returns threadid as 0 and total_threads as 1*/ \ - /* even if invoked from multithreaded application. */ \ - /* Support for actual thread number will be added in future */ \ - thread_id = 0;\ - total_threads = 1;\ - }\ + aocl_fla_progress_callback aocl_fla_progress_ptr = aocl_fla_progress_glb_ptr;\ + static TLS_CLASS_SPEC integer progress_step_count = 0;\ + static TLS_CLASS_SPEC integer progress_thread_id = 0;\ + static TLS_CLASS_SPEC integer progress_total_threads = 1;\ + progress_thread_id = omp_get_thread_num();\ + progress_total_threads = omp_get_num_threads();\ + +#else + +#define AOCL_FLA_PROGRESS_VAR \ + aocl_fla_progress_callback aocl_fla_progress_ptr = aocl_fla_progress_glb_ptr;\ + static TLS_CLASS_SPEC integer progress_step_count = 0;\ + static TLS_CLASS_SPEC integer progress_thread_id = 0;\ + static TLS_CLASS_SPEC integer progress_total_threads = 1;\ + progress_thread_id = 0;\ + progress_total_threads = 1;\ + +#endif diff --git a/src/base/flamec/main/FLA_Context.c b/src/base/flamec/main/FLA_Context.c index 704aa6121..33e4e899c 100644 --- a/src/base/flamec/main/FLA_Context.c +++ b/src/base/flamec/main/FLA_Context.c @@ -1,5 +1,5 @@ /* ************************************************************************ - * Copyright (c) 2022 Advanced Micro Devices, Inc. + * Copyright (c) 2022-2023 Advanced Micro Devices, Inc. All rights reserved. * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal @@ -118,8 +118,14 @@ void fla_pthread_once(fla_pthread_once_t *once, void (*init)(void)) #endif // !defined(FLA_NO_CONTEXT) && !defined(_MSC_VER) -// The global fla_context structure, which holds the global thread,ISA settings -fla_context global_context; +// The global fla_context structure, which holds the global thread count +// and ISA settings +fla_context global_context = FLA_CONTEXT_INITIALIZER; + +// The global fla_context structure, which holds the updated thread-local +// thread count +TLS_CLASS_SPEC fla_tl_context tl_context = FLA_TL_CONTEXT_INITIALIZER; +TLS_CLASS_SPEC FLA_Bool tl_context_init = FALSE; // A mutex to allow synchronous access to global_thread. fla_pthread_mutex_t global_thread_mutex = FLA_PTHREAD_MUTEX_INITIALIZER; @@ -152,24 +158,93 @@ int fla_env_get_var(const char *env, int fallback) return r_val; } +// This updates global_context void fla_thread_init_rntm_from_env(fla_context *context) { int nt; + FLA_Bool libflame_mt; #ifdef FLA_OPENMP_MULTITHREADING // Try to read FLA_NUM_THREADS first. nt = fla_env_get_var("FLA_NUM_THREADS", -1); - // If FLA_NUM_THREADS was not set, read OpenMP's omp_get_max_threads() to get maximum number - // of threads that library can use + // If FLA_NUM_THREADS was not set, set OpenMP threading in a + // subsequent call to fla_thread_update_rntm_from_env(). if(nt == -1) - nt = omp_get_max_threads(); + { + libflame_mt = FALSE; + } + else + { + libflame_mt = TRUE; + } #else // If multi-thread mode not configured, set maximum threads as 1 nt = 1; + libflame_mt = FALSE; #endif context->num_threads = nt; + context->libflame_mt = libflame_mt; +} + +// This updates tl_context +void fla_thread_update_rntm_from_env(fla_tl_context *context) +{ + +#ifdef FLA_OPENMP_MULTITHREADING + + if( !tl_context_init ) + { + // On first call for each thread, need to check settings from + // BLIS environment variables in global_context. First, set + // tl_context_init to TRUE for subsequent calls. + tl_context_init = TRUE; + + // Acquire the mutex protecting global_thread. + fla_pthread_mutex_lock(&global_thread_mutex); + + // Copy values from global_context. + context->num_threads = global_context.num_threads; + context->libflame_mt = global_context.libflame_mt; + + // Release the mutex protecting global_thread. + fla_pthread_mutex_unlock(&global_thread_mutex); + } + + // If FLA_NUM_THREADS was not set, read OpenMP's omp_get_max_threads() + // to get maximum number of threads that library can use. We also + // need to consider the number of active OpenMP levels and which + // level we are at. + if( !context->libflame_mt ) + { + int active_level = omp_get_active_level(); + int max_levels = omp_get_max_active_levels(); + if ( active_level < max_levels ) + { + context->num_threads = omp_get_max_threads(); + } + else + { + context->num_threads = 1; + } + } + +#else + + if( !tl_context_init ) + { + // First, set tl_context_init to TRUE for subsequent calls. + tl_context_init = TRUE; + + // Always set maximum threads as 1. These should never be + // changed so only set on first call. + context->num_threads = 1; + context->libflame_mt = FALSE; + } + +#endif + } void fla_isa_init(fla_context *context) @@ -179,6 +254,10 @@ void fla_isa_init(fla_context *context) { context->is_avx2 = TRUE; } + if (alcpu_flag_is_available(ALC_E_FLAG_AVX512F)) + { + context->is_avx512 = TRUE; + } } // ----------------------------------------------------------------------------- @@ -217,22 +296,28 @@ void aocl_fla_finalize(void) int fla_thread_get_num_threads(void) { - // We must ensure that global_rntm has been initialized. + // We must ensure that global_context and tl_context have been initialized. aocl_fla_init(); - return global_context.num_threads; + // Update the OpenMP information from the runtime, unless FLA_NUM_THREADS + // was set or fla_thread_set_num_threads() was called. + fla_thread_update_rntm_from_env(&tl_context); + + return tl_context.num_threads; } void fla_thread_set_num_threads(int n_threads) { + +#ifdef FLA_OPENMP_MULTITHREADING + // We must ensure that global_thread has been initialized. aocl_fla_init(); - // Acquire the mutex protecting global_thread. - fla_pthread_mutex_lock(&global_thread_mutex); + // Update values in tl_context for future reference + tl_context.num_threads = n_threads; + tl_context.libflame_mt = TRUE; - global_context.num_threads = n_threads; +#endif - // Release the mutex protecting global_thread. - fla_pthread_mutex_unlock(&global_thread_mutex); } diff --git a/src/base/flamec/main/FLA_Init.c b/src/base/flamec/main/FLA_Init.c index 87a807c3f..acac29d68 100644 --- a/src/base/flamec/main/FLA_Init.c +++ b/src/base/flamec/main/FLA_Init.c @@ -249,7 +249,7 @@ char* FLA_Get_AOCL_Version( void ) return lflibversion.version; } - char lfmainversion[] = "AOCL-libFLAME "; + char lfmainversion[] = "AOCL-LAPACK "; char* lfversion = lflibversion.version; char lapackversion[] = ", supports LAPACK 3.11.0"; int length, i; diff --git a/src/base/flamec/main/FLA_Memory.c b/src/base/flamec/main/FLA_Memory.c index 6611b25ac..e43be11c3 100644 --- a/src/base/flamec/main/FLA_Memory.c +++ b/src/base/flamec/main/FLA_Memory.c @@ -54,7 +54,7 @@ void FLA_Memory_leak_counter_finalize( void ) // Output the memory leak counter, but only if it's currently enabled. if ( FLA_Memory_leak_counter_status() == TRUE ) { - fprintf( stderr, "libflame: memory leak counter: %d\n", fla_mem_leak_counter ); + fprintf( stderr, "libflame: memory leak counter: %d\n", (int) fla_mem_leak_counter ); fflush( stderr ); } diff --git a/src/base/flamec/main/FLA_Misc.c b/src/base/flamec/main/FLA_Misc.c index 9ea1e67e2..eda6cd2a0 100644 --- a/src/base/flamec/main/FLA_Misc.c +++ b/src/base/flamec/main/FLA_Misc.c @@ -306,7 +306,7 @@ FLA_Error FLA_Obj_fshow( FILE* file, char *s1, FLA_Obj A, char *format, char *s2 scomplex* constc = FLA_COMPLEX_PTR( A ); dcomplex* constz = FLA_DOUBLE_COMPLEX_PTR( A ); - fprintf( file, "integer = %d\n", *consti ); + fprintf( file, "integer = %d\n", (int) *consti ); fprintf( file, "float = %e\n", *consts ); fprintf( file, "double = %e\n", *constd ); fprintf( file, "scomplex = %e + %e\n", constc->real, constc->imag ); diff --git a/src/base/flamec/main/FLA_Threads.c b/src/base/flamec/main/FLA_Threads.c index 8d91b93f9..f6f437d78 100644 --- a/src/base/flamec/main/FLA_Threads.c +++ b/src/base/flamec/main/FLA_Threads.c @@ -49,6 +49,7 @@ void FLA_Thread_get_subrange void FLA_Thread_optimum( API_ID family, int *actual_num_threads) { int optimal_num_threads = 0; + extern int fla_thread_get_num_threads(); switch(family) { @@ -66,7 +67,7 @@ void FLA_Thread_optimum( API_ID family, int *actual_num_threads) break; } - *actual_num_threads = global_context.num_threads; + *actual_num_threads = fla_thread_get_num_threads(); if(optimal_num_threads && (*actual_num_threads > optimal_num_threads)) *actual_num_threads = optimal_num_threads; diff --git a/src/base/flamec/util/base/FLA_Sort.c b/src/base/flamec/util/base/FLA_Sort.c index 0d651e547..67a5fd98e 100644 --- a/src/base/flamec/util/base/FLA_Sort.c +++ b/src/base/flamec/util/base/FLA_Sort.c @@ -91,7 +91,7 @@ FLA_Error FLA_Sort_f_ops( integer m_x, qsort( x, m_x, sizeof( float ), - fla_scomp_f ); + (const void *) fla_scomp_f ); return FLA_SUCCESS; } @@ -102,7 +102,7 @@ FLA_Error FLA_Sort_b_ops( integer m_x, qsort( x, m_x, sizeof( float ), - fla_scomp_b ); + (const void *) fla_scomp_b ); return FLA_SUCCESS; } @@ -113,7 +113,7 @@ FLA_Error FLA_Sort_f_opd( integer m_x, qsort( x, m_x, sizeof( double ), - fla_dcomp_f ); + (const void *) fla_dcomp_f ); return FLA_SUCCESS; } @@ -124,7 +124,7 @@ FLA_Error FLA_Sort_b_opd( integer m_x, qsort( x, m_x, sizeof( double ), - fla_dcomp_b ); + (const void *) fla_dcomp_b ); return FLA_SUCCESS; } diff --git a/src/base/flamec/util/base/FLA_env.c b/src/base/flamec/util/base/FLA_env.c index 7887afb6a..ebdcc23e7 100644 --- a/src/base/flamec/util/base/FLA_env.c +++ b/src/base/flamec/util/base/FLA_env.c @@ -1,5 +1,5 @@ /* - Copyright (c) 2021 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. Mar 16, 2021 */ @@ -31,19 +31,11 @@ integer FLA_env_get_var( const char* env, integer fallback ) integer FLASH_get_num_threads( integer fallback ) { - integer omp_threads, fla_threads; - omp_threads = FLA_env_get_var( "OMP_NUM_THREADS", -1 ); - fla_threads = FLA_env_get_var( "FLA_NUM_THREADS", -1 ); + integer fla_threads; + extern int fla_thread_get_num_threads(void); - if( ( omp_threads == -1 ) && ( fla_threads == -1 ) ) - { - fla_threads = fallback; - } - else if( fla_threads == -1 ) - { - fla_threads = omp_threads; - } + fla_threads = fla_thread_get_num_threads(); if( fla_threads <= 0 ) { diff --git a/src/base/flamec/util/lapack/FLA_Househ2_UT.c b/src/base/flamec/util/lapack/FLA_Househ2_UT.c index 596b6f0e4..66412b069 100644 --- a/src/base/flamec/util/lapack/FLA_Househ2_UT.c +++ b/src/base/flamec/util/lapack/FLA_Househ2_UT.c @@ -166,12 +166,10 @@ FLA_Error FLA_Househ2_UT_l_ops( integer m_x2, float y[2]; float alpha; float chi_1_minus_alpha; - float abs_chi_1; float norm_x_2; float norm_x; float abs_chi_1_minus_alpha; - float norm_x_2_div_abs_chi_1_minus_alpha; - float safmin, rsafmn, sclf, lchi1; + float safmin, rsafmn, lchi1; int i_one = 1; int i_two = 2; int kn; @@ -318,12 +316,10 @@ FLA_Error FLA_Househ2_UT_l_opd( integer m_x2, double y[2]; double alpha; double chi_1_minus_alpha; - double abs_chi_1; double norm_x_2; double norm_x; double abs_chi_1_minus_alpha; - double norm_x_2_div_abs_chi_1_minus_alpha; - double safmin, rsafmn, sclf, lchi1; + double safmin, rsafmn, lchi1; int i_one = 1; int i_two = 2; int kn; diff --git a/src/base/flamec/util/lapack/FLA_Sort_bsvd_ext.c b/src/base/flamec/util/lapack/FLA_Sort_bsvd_ext.c index c5833b625..2784f4601 100644 --- a/src/base/flamec/util/lapack/FLA_Sort_bsvd_ext.c +++ b/src/base/flamec/util/lapack/FLA_Sort_bsvd_ext.c @@ -82,6 +82,8 @@ FLA_Error FLA_Sort_bsvd_ext( FLA_Direct direct, FLA_Obj s, // apply_V, V, // apply_C, C ); + datatype = FLA_Obj_datatype(U); + // Sort singular values only; quick sort if ( apply_U == FALSE && apply_V == FALSE ) return FLA_Sort( direct, s ); diff --git a/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.c b/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.c index e87cb3c7f..58c75af53 100644 --- a/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.c +++ b/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.c @@ -31,6 +31,8 @@ #include "FLAME.h" #include "libflame_api_wrapper.h" +extern int xerbla_array_(char *srname_array__, integer *srname_len__, integer *info); + double DLAMCH( char *cmach) { return dlamch_( cmach); @@ -602,17 +604,17 @@ int CGELSS_(integer* m, integer* n, integer* nrhs, scomplex* a, integer* lda, sc return cgelss_( m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, info); } -int CGELST(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info) +int CGELST(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info) { return cgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } -int cgelst(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info) +int cgelst(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info) { return cgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } -int CGELST_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info) +int CGELST_(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info) { return cgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } @@ -4133,17 +4135,17 @@ int CLATRS_(char* uplo, char* trans, char* diag, char* normin, integer* n, scomp return clatrs_( uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info); } -int CLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) +int CLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) { return clatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } -int clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) +int clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) { return clatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } -int CLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) +int CLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info) { return clatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } @@ -6221,17 +6223,17 @@ int CTRSYL_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, sco return ctrsyl_( trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info); } -int CTRSYL3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) +int CTRSYL3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) { return ctrsyl3_(trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } -int ctrsyl3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) +int ctrsyl3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) { return ctrsyl3_(trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } -int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) +int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info) { return ctrsyl3_(trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } @@ -14719,17 +14721,17 @@ int SGELSS_(integer* m, integer* n, integer* nrhs, float* a, integer* lda, float int SGELST(char *trans, integer *m, integer *n, integer * nrhs, real *a, integer *lda, real *b, integer *ldb, real *work, integer *lwork, integer *info) { - sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } int sgelst(char *trans, integer *m, integer *n, integer * nrhs, real *a, integer *lda, real *b, integer *ldb, real *work, integer *lwork, integer *info) { - sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } int SGELST_(char *trans, integer *m, integer *n, integer * nrhs, real *a, integer *lda, real *b, integer *ldb, real *work, integer *lwork, integer *info) { - sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return sgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } int SGELSX(integer* m, integer* n, integer* nrhs, float* a, integer* lda, float* b, integer* ldb, integer* jpvt, float* rcond, integer* rank, float* work, integer* info) @@ -21594,19 +21596,19 @@ int ZGELSS_(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dc return zgelss_( m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, info); } -int ZGELST(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info) +int ZGELST(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info) { - zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } -int zgelst(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info) +int zgelst(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info) { - zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } -int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info) +int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info) { - zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); + return zgelst_(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info); } int ZGELSX(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, integer* jpvt, double* rcond, integer* rank, dcomplex* work, double* rwork, integer* info) @@ -25139,17 +25141,17 @@ int ZLATRS_(char* uplo, char* trans, char* diag, char* normin, integer* n, dcomp return zlatrs_( uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info); } -int ZLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) +int ZLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) { return zlatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } -int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) +int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) { return zlatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } -int ZLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) +int ZLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info) { return zlatrs3_(uplo, trans, diag, normin, n, nrhs, a, lda, x, ldx, scale, cnorm, work, lwork, info); } @@ -27211,17 +27213,17 @@ int ZTRSYL_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, dco return ztrsyl_( trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info); } -int ZTRSYL3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) +int ZTRSYL3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) { return ztrsyl3_( trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } -int ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) +int ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) { return ztrsyl3_( trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } -int ZTRSYL3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) +int ZTRSYL3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info) { return ztrsyl3_( trana, tranb, isgn, m, n, a, lda, b, ldb, c__, ldc, scale, swork, ldswork, info); } @@ -27931,17 +27933,17 @@ float SLAMC3_( float *a, float *b) return slamc3_( a, b); } -int SISNAN(const float *sin) +int SISNAN(float *sin) { return sisnan_( sin); } -int sisnan(const float *sin) +int sisnan(float *sin) { return sisnan_( sin); } -int SISNAN_(const float *sin) +int SISNAN_(float *sin) { return sisnan_( sin); } @@ -30124,107 +30126,107 @@ int LZSPR_( char *uplo, integer *n, dcomplex *alpha, dcomplex *x, integer *incx, } -int CGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int CGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int cgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int cgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int CGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int CGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int CLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info) +int CLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info) { return claqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int claqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info) +int claqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info) { return claqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int CLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info) +int CLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info) { return claqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int CLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz) +int CLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz) { return claqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int claqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz) +int claqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz) { return claqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int CLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz) +int CLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz) { return claqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int CLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info) +int CLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info) { return claqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int claqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info) +int claqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info) { return claqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int CLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info) +int CLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info) { return claqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int CLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info) +int CLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info) { return claqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int claqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info) +int claqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info) { return claqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int CLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info) +int CLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info) { return claqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int CLARFB_GETT(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork) +int CLARFB_GETT(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork) { return clarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int clarfb_gett(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork) +int clarfb_gett(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork) { return clarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int CLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork) +int CLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork) { return clarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int CUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int CUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } -int cungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int cungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } -int CUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info) +int CUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info) { return cungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } @@ -30486,7 +30488,7 @@ int SORGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, real *a, int int XERBLA_ARRAY(char *srname_array__, integer *srname_len__, integer *info) { - return xerbla_array_( srname_array__, srname_len__, info); + return xerbla_array_( srname_array__, srname_len__, info); } int xerbla_array(char *srname_array__, integer *srname_len__, integer *info) @@ -30499,107 +30501,107 @@ int XERBLA_ARRAY_(char *srname_array__, integer *srname_len__, integer *info) return xerbla_array_( srname_array__, srname_len__, info); } -int ZGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int ZGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int zgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int zgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int ZGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int ZGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zgetsqrhrt_( m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork, info); } -int ZLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) +int ZLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) { return zlaqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int zlaqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) +int zlaqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) { return zlaqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int ZLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) +int ZLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info) { return zlaqz0_( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alpha, beta, q, ldq, z__, ldz, work, lwork, rwork, rec, info); } -int ZLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz) +int ZLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz) { return zlaqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int zlaqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz) +int zlaqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz) { return zlaqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int ZLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz) +int ZLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz) { return zlaqz1_( ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z__, ldz); } -int ZLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) +int ZLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) { return zlaqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int zlaqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) +int zlaqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) { return zlaqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int ZLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) +int ZLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info) { return zlaqz2_( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z__, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info); } -int ZLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info) +int ZLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info) { return zlaqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int zlaqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info) +int zlaqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info) { return zlaqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int ZLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info) +int ZLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info) { return zlaqz3_( ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired__, alpha, beta, a, lda, b, ldb, q, ldq, z__, ldz, qc, ldqc, zc, ldzc, work, lwork, info); } -int ZLARFB_GETT(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork) +int ZLARFB_GETT(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork) { return zlarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int zlarfb_gett(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork) +int zlarfb_gett(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork) { return zlarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int ZLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork) +int ZLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork) { return zlarfb_gett_( ident, m, n, k, t, ldt, a, lda, b, ldb, work, ldwork); } -int ZUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int ZUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } -int zungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int zungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } -int ZUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info) +int ZUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info) { return zungtsqr_row_( m, n, mb, nb, a, lda, t, ldt, work, lwork, info); } diff --git a/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.h b/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.h index f1728ce4c..ca4e2368d 100644 --- a/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.h +++ b/src/base/flamec/wrappers/base/wrapper/libflame_api_wrapper.h @@ -181,9 +181,9 @@ extern int CGELSS(integer* m, integer* n, integer* nrhs, scomplex* a, integer* l extern int cgelss(integer* m, integer* n, integer* nrhs, scomplex* a, integer* lda, scomplex* b, integer* ldb, float* s, float* rcond, integer* rank, scomplex* work, integer* lwork, float* rwork, integer* info); extern int CGELSS_(integer* m, integer* n, integer* nrhs, scomplex* a, integer* lda, scomplex* b, integer* ldb, float* s, float* rcond, integer* rank, scomplex* work, integer* lwork, float* rwork, integer* info); -extern int CGELST(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info); -extern int cgelst(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info); -extern int CGELST_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex * work, integer *lwork, integer *info); +extern int CGELST(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info); +extern int cgelst(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info); +extern int CGELST_(char *trans, integer *m, integer *n, integer * nrhs, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex * work, integer *lwork, integer *info); extern int CGELSX(integer* m, integer* n, integer* nrhs, scomplex* a, integer* lda, scomplex* b, integer* ldb, integer* jpvt, float* rcond, integer* rank, scomplex* work, float* rwork, integer* info); extern int cgelsx(integer* m, integer* n, integer* nrhs, scomplex* a, integer* lda, scomplex* b, integer* ldb, integer* jpvt, float* rcond, integer* rank, scomplex* work, float* rwork, integer* info); @@ -1121,9 +1121,9 @@ extern int CLATRS(char* uplo, char* trans, char* diag, char* normin, integer* n, extern int clatrs(char* uplo, char* trans, char* diag, char* normin, integer* n, scomplex* a, integer* lda, scomplex* x, float* scale, float* cnorm, integer* info); extern int CLATRS_(char* uplo, char* trans, char* diag, char* normin, integer* n, scomplex* a, integer* lda, scomplex* x, float* scale, float* cnorm, integer* info); -extern int CLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); -extern int clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); -extern int CLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, complex *a, integer *lda, complex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); +extern int CLATRS3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); +extern int clatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); +extern int CLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, scomplex *a, integer *lda, scomplex * x, integer *ldx, real *scale, real *cnorm, real *work, integer *lwork, integer *info); extern int CLATRZ(integer* m, integer* n, integer* l, scomplex* a, integer* lda, scomplex* tau, scomplex* work); extern int clatrz(integer* m, integer* n, integer* l, scomplex* a, integer* lda, scomplex* tau, scomplex* work); @@ -1677,9 +1677,9 @@ extern int CTRSYL(char* trana, char* tranb, integer* isgn, integer* m, integer* extern int ctrsyl(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c, integer* ldc, float* scale, integer* info); extern int CTRSYL_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c, integer* ldc, float* scale, integer* info); -extern int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); -extern int ctrsyl3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); -extern int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, complex* a, integer* lda, complex* b, integer* ldb, complex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); +extern int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); +extern int ctrsyl3(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); +extern int CTRSYL3_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, scomplex* a, integer* lda, scomplex* b, integer* ldb, scomplex* c__, integer* ldc, real* scale, real* swork, integer* ldswork, integer* info); extern int CTRTI2(char* uplo, char* diag, integer* n, scomplex* a, integer* lda, integer* info); extern int ctrti2(char* uplo, char* diag, integer* n, scomplex* a, integer* lda, integer* info); @@ -5769,9 +5769,9 @@ extern int ZGELSS(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* l extern int zgelss(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, double* s, double* rcond, integer* rank, dcomplex* work, integer* lwork, double* rwork, integer* info); extern int ZGELSS_(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, double* s, double* rcond, integer* rank, dcomplex* work, integer* lwork, double* rwork, integer* info); -extern int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info); -extern int zgelst(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info); -extern int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info); +extern int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info); +extern int zgelst(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info); +extern int ZGELST_(char *trans, integer *m, integer *n, integer * nrhs, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer *lwork, integer *info); extern int ZGELSX(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, integer* jpvt, double* rcond, integer* rank, dcomplex* work, double* rwork, integer* info); extern int zgelsx(integer* m, integer* n, integer* nrhs, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, integer* jpvt, double* rcond, integer* rank, dcomplex* work, double* rwork, integer* info); @@ -6713,9 +6713,9 @@ extern int ZLATRS(char* uplo, char* trans, char* diag, char* normin, integer* n, extern int zlatrs(char* uplo, char* trans, char* diag, char* normin, integer* n, dcomplex* a, integer* lda, dcomplex* x, double* scale, double* cnorm, integer* info); extern int ZLATRS_(char* uplo, char* trans, char* diag, char* normin, integer* n, dcomplex* a, integer* lda, dcomplex* x, double* scale, double* cnorm, integer* info); -extern int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); -extern int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); -extern int ZLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); +extern int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); +extern int zlatrs3(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); +extern int ZLATRS3_(char *uplo, char *trans, char *diag, char * normin, integer *n, integer *nrhs, dcomplex *a, integer *lda, dcomplex *x, integer *ldx, doublereal *scale, doublereal *cnorm, doublereal *work, integer *lwork, integer *info); extern int ZLATRZ(integer* m, integer* n, integer* l, dcomplex* a, integer* lda, dcomplex* tau, dcomplex* work); extern int zlatrz(integer* m, integer* n, integer* l, dcomplex* a, integer* lda, dcomplex* tau, dcomplex* work); @@ -7265,9 +7265,9 @@ extern int ZTRSYL(char* trana, char* tranb, integer* isgn, integer* m, integer* extern int ztrsyl(char* trana, char* tranb, integer* isgn, integer* m, integer* n, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, dcomplex* c, integer* ldc, double* scale, integer* info); extern int ZTRSYL_(char* trana, char* tranb, integer* isgn, integer* m, integer* n, dcomplex* a, integer* lda, dcomplex* b, integer* ldb, dcomplex* c, integer* ldc, double* scale, integer* info); -extern int ZTRSYL3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); -extern int ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); -extern int ZTRSYL3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); +extern int ZTRSYL3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); +extern int ztrsyl3(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); +extern int ZTRSYL3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *c__, integer *ldc, doublereal *scale, doublereal *swork, integer *ldswork, integer *info); extern int ZTRTI2(char* uplo, char* diag, integer* n, dcomplex* a, integer* lda, integer* info); extern int ztrti2(char* uplo, char* diag, integer* n, dcomplex* a, integer* lda, integer* info); @@ -7453,13 +7453,13 @@ extern float SLAMCH(char *cmach); extern float slamch(char *cmach); extern float SLAMCH_(char *cmach); - extern float SLAMC3( float *a, float *b); - extern float slamc3( float *a, float *b); - extern float SLAMC3_( float *a, float *b); +extern float SLAMC3( float *a, float *b); +extern float slamc3( float *a, float *b); +extern float SLAMC3_( float *a, float *b); - extern int SISNAN(const float *sin); -extern int sisnan(const float *sin); -extern int SISNAN_(const float *sin); +extern int SISNAN(float *sin); +extern int sisnan(float *sin); +extern int SISNAN_(float *sin); extern int LSAMEN(const integer *n,const char *ca,const char *cb,integer ca_len,integer cb_len); extern int lsamen(const integer *n,const char *ca,const char *cb,integer ca_len,integer cb_len); @@ -8045,33 +8045,33 @@ extern int LZSPR( char *uplo, integer *n, dcomplex *alpha, dcomplex *x, integer extern int lzspr( char *uplo, integer *n, dcomplex *alpha, dcomplex *x, integer *incx, dcomplex *ap, dcomplex *work ); extern int LZSPR_( char *uplo, integer *n, dcomplex *alpha, dcomplex *x, integer *incx, dcomplex *ap, dcomplex *work ); -extern int CGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); -extern int cgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); -extern int CGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); +extern int CGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); +extern int cgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); +extern int CGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); -extern int CLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info); -extern int claqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info); -extern int CLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq, complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *rec, integer *info); +extern int CLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info); +extern int claqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info); +extern int CLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *alpha, scomplex *beta, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *work, integer *lwork, real * rwork, integer *rec, integer *info); -extern int CLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz); -extern int claqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz); -extern int CLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb, integer *nq, integer *qstart, complex *q, integer *ldq, integer *nz, integer *zstart, complex *z__, integer * ldz); +extern int CLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz); +extern int claqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz); +extern int CLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, scomplex *a, integer *lda, scomplex *b, integer *ldb, integer *nq, integer *qstart, scomplex *q, integer *ldq, integer *nz, integer *zstart, scomplex *z__, integer * ldz); -extern int CLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info); -extern int claqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info); -extern int CLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, complex *a, integer *lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, integer *ns, integer *nd, complex *alpha, complex *beta, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, real *rwork, integer *rec, integer * info); +extern int CLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info); +extern int claqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info); +extern int CLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, integer *ns, integer *nd, scomplex *alpha, scomplex *beta, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, real *rwork, integer *rec, integer * info); -extern int CLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info); -extern int claqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info); -extern int CLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, complex *alpha, complex *beta, complex *a, integer * lda, complex *b, integer *ldb, complex *q, integer *ldq, complex *z__, integer *ldz, complex *qc, integer *ldqc, complex *zc, integer *ldzc, complex *work, integer *lwork, integer *info); +extern int CLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info); +extern int claqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info); +extern int CLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, scomplex *alpha, scomplex *beta, scomplex *a, integer * lda, scomplex *b, integer *ldb, scomplex *q, integer *ldq, scomplex *z__, integer *ldz, scomplex *qc, integer *ldqc, scomplex *zc, integer *ldzc, scomplex *work, integer *lwork, integer *info); -extern int CLARFB_GETT(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork); -extern int clarfb_gett(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork); -extern int CLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, complex *t, integer *ldt, complex *a, integer *lda, complex *b, integer *ldb, complex *work, integer *ldwork); +extern int CLARFB_GETT(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork); +extern int clarfb_gett(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork); +extern int CLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, scomplex *t, integer *ldt, scomplex *a, integer *lda, scomplex *b, integer *ldb, scomplex *work, integer *ldwork); -extern int CUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); -extern int cungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); -extern int CUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, complex *a, integer *lda, complex *t, integer *ldt, complex *work, integer *lwork, integer *info); +extern int CUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); +extern int cungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); +extern int CUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, scomplex *a, integer *lda, scomplex *t, integer *ldt, scomplex *work, integer *lwork, integer *info); extern int DGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublereal *a, integer *lda, doublereal * t, integer *ldt, doublereal *work, integer *lwork, integer *info); extern int dgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublereal *a, integer *lda, doublereal * t, integer *ldt, doublereal *work, integer *lwork, integer *info); @@ -8145,33 +8145,33 @@ extern int SORGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, real * extern int sorgtsqr_row(integer *m, integer *n, integer *mb, integer *nb, real *a, integer *lda, real *t, integer *ldt, real *work, integer *lwork, integer *info); extern int SORGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, real *a, integer *lda, real *t, integer *ldt, real *work, integer *lwork, integer *info); -extern int ZGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); -extern int zgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); -extern int ZGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); +extern int ZGETSQRHRT(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); +extern int zgetsqrhrt(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); +extern int ZGETSQRHRT_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); -extern int ZLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); -extern int zlaqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); -extern int ZLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex * beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer * ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); +extern int ZLAQZ0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); +extern int zlaqz0(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); +extern int ZLAQZ0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, integer *ihi, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *alpha, dcomplex * beta, dcomplex *q, integer *ldq, dcomplex *z__, integer * ldz, dcomplex *work, integer *lwork, doublereal *rwork, integer * rec, integer *info); -extern int ZLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz); -extern int zlaqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz); -extern int ZLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, doublecomplex *a, integer * lda, doublecomplex *b, integer *ldb, integer *nq, integer *qstart, doublecomplex *q, integer *ldq, integer *nz, integer *zstart, doublecomplex *z__, integer *ldz); +extern int ZLAQZ1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz); +extern int zlaqz1(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz); +extern int ZLAQZ1_(logical *ilq, logical *ilz, integer *k, integer * istartm, integer *istopm, integer *ihi, dcomplex *a, integer * lda, dcomplex *b, integer *ldb, integer *nq, integer *qstart, dcomplex *q, integer *ldq, integer *nz, integer *zstart, dcomplex *z__, integer *ldz); -extern int ZLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); -extern int zlaqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); -extern int ZLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, integer *ns, integer * nd, doublecomplex *alpha, doublecomplex *beta, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); +extern int ZLAQZ2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); +extern int zlaqz2(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); +extern int ZLAQZ2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nw, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, integer *ns, integer * nd, dcomplex *alpha, dcomplex *beta, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, doublereal *rwork, integer *rec, integer *info); -extern int ZLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info); -extern int zlaqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info); -extern int ZLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, doublecomplex *qc, integer *ldqc, doublecomplex *zc, integer *ldzc, doublecomplex *work, integer *lwork, integer *info); +extern int ZLAQZ3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info); +extern int zlaqz3(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info); +extern int ZLAQZ3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *ilo, integer *ihi, integer *nshifts, integer * nblock_desired__, dcomplex *alpha, dcomplex *beta, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *q, integer *ldq, dcomplex *z__, integer *ldz, dcomplex *qc, integer *ldqc, dcomplex *zc, integer *ldzc, dcomplex *work, integer *lwork, integer *info); -extern int ZLARFB_GETT(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork); -extern int zlarfb_gett(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork); -extern int ZLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, doublecomplex *t, integer *ldt, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer * ldwork); +extern int ZLARFB_GETT(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork); +extern int zlarfb_gett(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork); +extern int ZLARFB_GETT_(char *ident, integer *m, integer *n, integer *k, dcomplex *t, integer *ldt, dcomplex *a, integer *lda, dcomplex *b, integer *ldb, dcomplex *work, integer * ldwork); -extern int ZUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); -extern int zungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); -extern int ZUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, doublecomplex *a, integer *lda, doublecomplex *t, integer *ldt, doublecomplex *work, integer *lwork, integer *info); +extern int ZUNGTSQR_ROW(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); +extern int zungtsqr_row(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); +extern int ZUNGTSQR_ROW_(integer *m, integer *n, integer *mb, integer *nb, dcomplex *a, integer *lda, dcomplex *t, integer *ldt, dcomplex *work, integer *lwork, integer *info); extern int DLADIV1(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *p, doublereal *q); extern int dladiv1(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *p, doublereal *q); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Apply_Q_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Apply_Q_blk_external.c index ca90372d5..3960d8779 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Apply_Q_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Apply_Q_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Apply_Q_blk_external( FLA_Side side, FLA_Trans trans, FLA_Store storev, FLA_Obj A, FLA_Obj t, FLA_Obj B ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; // integer m_A, n_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Apply_pivots_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Apply_pivots_unb_external.c index 73007947d..5b400ebc2 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Apply_pivots_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Apply_pivots_unb_external.c @@ -48,7 +48,7 @@ FLA_Error FLA_Apply_pivots_unb_external( FLA_Side side, FLA_Trans trans, FLA_Obj #ifdef FLA_ENABLE_WINDOWS_BUILD pivots_lapack = ( integer * ) _alloca( m_p * sizeof( integer ) ); #else - pivots_lapack = ( integer * ) alloca( m_p * sizeof( integer ) ); + pivots_lapack = ( integer * ) malloc( m_p * sizeof( integer ) ); #endif for ( i = 0; i < m_p; i++ ) diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_U_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_U_external.c index 8b5457d8a..b72132e9f 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_U_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_U_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Bidiag_apply_U_external( FLA_Side side, FLA_Trans trans, FLA_Obj A, FLA_Obj t, FLA_Obj B ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; // integer m_A, n_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_V_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_V_external.c index 27c20eea9..aff12dc10 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_V_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_apply_V_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Bidiag_apply_V_external( FLA_Side side, FLA_Trans trans, FLA_Obj A, FLA_Obj t, FLA_Obj B ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; // integer m_A, n_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_blk_external.c index 69f44b734..e8c1b315c 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_blk_external.c @@ -12,11 +12,11 @@ FLA_Error FLA_Bidiag_blk_external( FLA_Obj A, FLA_Obj tu, FLA_Obj tv ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; - integer min_m_n, max_m_n; + integer min_m_n; integer lwork; FLA_Obj d, e, work_obj; @@ -30,7 +30,6 @@ FLA_Error FLA_Bidiag_blk_external( FLA_Obj A, FLA_Obj tu, FLA_Obj tv ) m_A = FLA_Obj_length( A ); n_A = FLA_Obj_width( A ); min_m_n = FLA_Obj_min_dim( A ); - max_m_n = FLA_Obj_max_dim( A ); cs_A = FLA_Obj_col_stride( A ); FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), min_m_n, 1, 0, 0, &d ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_U_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_U_external.c index cfa7ac48c..19f06d965 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_U_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_U_external.c @@ -12,12 +12,11 @@ FLA_Error FLA_Bidiag_form_U_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, k_A; integer cs_A; - integer min_m_n; integer lwork; FLA_Obj work; char blas_vect = 'Q'; @@ -34,8 +33,6 @@ FLA_Error FLA_Bidiag_form_U_external( FLA_Obj A, FLA_Obj t ) n_A = FLA_Obj_width( A ); cs_A = FLA_Obj_col_stride( A ); - min_m_n = FLA_Obj_min_dim( A ); - if ( blas_vect == 'Q' ) k_A = FLA_Obj_vector_dim( t ); else k_A = FLA_Obj_vector_dim( t ) + 1; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_V_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_V_external.c index 667739e62..fe80a25f7 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_V_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_form_V_external.c @@ -12,12 +12,11 @@ FLA_Error FLA_Bidiag_form_V_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, k_A; integer cs_A; - integer min_m_n; integer lwork; FLA_Obj work; char blas_vect = 'P'; @@ -34,8 +33,6 @@ FLA_Error FLA_Bidiag_form_V_external( FLA_Obj A, FLA_Obj t ) n_A = FLA_Obj_width( A ); cs_A = FLA_Obj_col_stride( A ); - min_m_n = FLA_Obj_min_dim( A ); - if ( blas_vect == 'Q' ) k_A = FLA_Obj_vector_dim( t ); else k_A = FLA_Obj_vector_dim( t ) + 1; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_unb_external.c index 815a7ea7f..f393b3b41 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bidiag_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Bidiag_unb_external( FLA_Obj A, FLA_Obj tu, FLA_Obj tv ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bsvd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bsvd_external.c index 6c7570983..bb1915daa 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bsvd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bsvd_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Bsvd_external( FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA_Obj V ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; @@ -20,7 +20,6 @@ FLA_Error FLA_Bsvd_external( FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA integer n_V, cs_V; integer n_C, cs_C; integer min_m_n; - integer inc_d, inc_e; integer lrwork; FLA_Obj rwork; char blas_uplo; @@ -44,9 +43,6 @@ FLA_Error FLA_Bsvd_external( FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA min_m_n = FLA_Obj_vector_dim( d ); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - lrwork = fla_max( 1, 4 * min_m_n - 4 ); FLA_Obj_create( dt_real, lrwork, 1, 0, 0, &rwork ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Bsvdd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Bsvdd_external.c index 3fc44094b..763edb41e 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Bsvdd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Bsvdd_external.c @@ -12,15 +12,13 @@ FLA_Error FLA_Bsvdd_external( FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA_Obj V ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; - integer m_U, cs_U; - integer n_V, cs_V; - integer n_C, cs_C; + integer cs_U; + integer cs_V; integer min_m_n; - integer inc_d, inc_e; integer lwork, liwork; FLA_Obj work, iwork; char blas_uplo; @@ -34,20 +32,12 @@ FLA_Error FLA_Bsvdd_external( FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FL datatype = FLA_Obj_datatype( U ); dt_real = FLA_Obj_datatype_proj_to_real( U ); - m_U = FLA_Obj_length( U ); cs_U = FLA_Obj_col_stride( U ); - n_V = FLA_Obj_length( V ); cs_V = FLA_Obj_col_stride( V ); - n_C = 0; - cs_C = 1; - min_m_n = FLA_Obj_vector_dim( d ); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - lwork = fla_max( 1, 3*min_m_n*min_m_n + 4*min_m_n ); liwork = 8*min_m_n; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Hess_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Hess_blk_external.c index bb5ebd544..39ae2314f 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Hess_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Hess_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Hess_blk_external( FLA_Obj A, FLA_Obj t, integer ilo, integer ihi ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Hess_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Hess_unb_external.c index 4d45f9846..7c4d0b0ba 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Hess_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Hess_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Hess_unb_external( FLA_Obj A, FLA_Obj t, integer ilo, integer ihi ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Hevd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Hevd_external.c index c88f84ae2..4fda5bb5e 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Hevd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Hevd_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Hevd_external( FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj e ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Hevdd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Hevdd_external.c index 3ea8a6656..e7c2d79df 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Hevdd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Hevdd_external.c @@ -12,10 +12,9 @@ FLA_Error FLA_Hevdd_external( FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj e ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; - FLA_Datatype dt_real; integer n_A, cs_A; integer lwork, lrwork, liwork; FLA_Obj work, rwork, iwork; @@ -29,7 +28,6 @@ FLA_Error FLA_Hevdd_external( FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_O if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); - dt_real = FLA_Obj_datatype_proj_to_real( A ); n_A = FLA_Obj_width( A ); cs_A = FLA_Obj_col_stride( A ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Hevdr_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Hevdr_external.c index 539641037..d8e04ece1 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Hevdr_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Hevdr_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Hevdr_external( FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj l, FLA_Obj Z ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_LQ_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_LQ_blk_external.c index da15ba67d..9dab8649f 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_LQ_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_LQ_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_LQ_blk_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_LQ_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_LQ_unb_external.c index 13ef1a855..22bd8cde7 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_LQ_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_LQ_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_LQ_unb_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_QR_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_QR_blk_external.c index 8ff303f12..0a40b6c0a 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_QR_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_QR_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_QR_blk_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_QR_form_Q_external.c b/src/base/flamec/wrappers/lapack/external/FLA_QR_form_Q_external.c index 68f3c2521..3f633ea91 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_QR_form_Q_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_QR_form_Q_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_QR_form_Q_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, k_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_QR_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_QR_unb_external.c index 637049299..9d7fb0e4c 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_QR_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_QR_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_QR_unb_external( FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Svd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Svd_external.c index a0582e1a7..a2e563517 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Svd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Svd_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Svd_external( FLA_Svd_type jobu, FLA_Svd_type jobv, FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Svdd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Svdd_external.c index 5e8dce2f5..15c8e23d5 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Svdd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Svdd_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Svdd_external( FLA_Svd_type jobz, FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Sylv_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Sylv_unb_external.c index ff70a7305..7dbd73a67 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Sylv_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Sylv_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Sylv_unb_external( FLA_Trans transa, FLA_Trans transb, FLA_Obj isgn, FLA_Obj A, FLA_Obj B, FLA_Obj C, FLA_Obj scale ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tevd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tevd_external.c index 15f29267b..805a7e158 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tevd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tevd_external.c @@ -12,12 +12,11 @@ FLA_Error FLA_Tevd_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; integer n_A, cs_A; - integer inc_d, inc_e; integer lwork; FLA_Obj work, d_use, e_use; char blas_jobz; @@ -47,9 +46,6 @@ FLA_Error FLA_Tevd_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A } else { e_use = e; } - inc_d = FLA_Obj_vector_inc( d_use ); - inc_e = FLA_Obj_vector_inc( e_use ); - // Allocate thw work array up front. lwork = fla_max( 1.0, 2.0 * n_A - 2 ); FLA_Obj_create( dt_real, lwork, 1, 0, 0, &work ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tevdd_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tevdd_external.c index 32bdf8584..3c7b7ffd1 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tevdd_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tevdd_external.c @@ -12,10 +12,9 @@ FLA_Error FLA_Tevdd_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; - FLA_Datatype dt_real; integer n_A, cs_A; integer lwork, lrwork, liwork; FLA_Obj work, rwork, iwork; @@ -28,7 +27,6 @@ FLA_Error FLA_Tevdd_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); - dt_real = FLA_Obj_datatype_proj_to_real( A ); n_A = FLA_Obj_width( A ); cs_A = FLA_Obj_col_stride( A ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tevdr_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tevdr_external.c index 4db8472ae..dbc985df2 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tevdr_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tevdr_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l, FLA_Obj A ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; FLA_Datatype dt_real; @@ -41,6 +41,9 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz ); + vl = 0; + vu = 0; + // Hard-code some parameters. blas_range = 'A'; nzc = n_A; @@ -93,13 +96,15 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l integer* buff_isuppz = ( integer* ) FLA_INT_PTR( isuppz ); float* buff_work = ( float* ) FLA_FLOAT_PTR( work ); integer* buff_iwork = ( integer* ) FLA_INT_PTR( iwork ); - + float vlf = (float) vl; + float vuf = (float) vu; + F77_sstemr( &blas_jobz, &blas_range, &n_A, buff_d, buff_e, - &vl, &vu, + &vlf, &vuf, &il, &iu, &n_eig_found, buff_l, @@ -123,13 +128,15 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l integer* buff_isuppz = ( integer* ) FLA_INT_PTR( isuppz ); double* buff_work = ( double* ) FLA_DOUBLE_PTR( work ); integer* buff_iwork = ( integer* ) FLA_INT_PTR( iwork ); + double vlf = (double) vl; + double vuf = (double) vu; F77_dstemr( &blas_jobz, &blas_range, &n_A, buff_d, buff_e, - &vl, &vu, + &vlf, &vuf, &il, &iu, &n_eig_found, buff_l, @@ -153,13 +160,15 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l integer* buff_isuppz = ( integer* ) FLA_INT_PTR( isuppz ); float* buff_work = ( float* ) FLA_FLOAT_PTR( work ); integer* buff_iwork = ( integer* ) FLA_INT_PTR( iwork ); + float vlf = (float) vl; + float vuf = (float) vu; F77_cstemr( &blas_jobz, &blas_range, &n_A, buff_d, buff_e, - &vl, &vu, + &vlf, &vuf, &il, &iu, &n_eig_found, buff_l, @@ -183,13 +192,15 @@ FLA_Error FLA_Tevdr_external( FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l integer* buff_isuppz = ( integer* ) FLA_INT_PTR( isuppz ); double* buff_work = ( double* ) FLA_DOUBLE_PTR( work ); integer* buff_iwork = ( integer* ) FLA_INT_PTR( iwork ); + double vlf = (double) vl; + double vuf = (double) vu; F77_zstemr( &blas_jobz, &blas_range, &n_A, buff_d, buff_e, - &vl, &vu, + &vlf, &vuf, &il, &iu, &n_eig_found, buff_l, diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_apply_Q_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_apply_Q_external.c index b895aea98..f3537b89e 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_apply_Q_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_apply_Q_external.c @@ -12,14 +12,13 @@ FLA_Error FLA_Tridiag_apply_Q_external( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Obj A, FLA_Obj t, FLA_Obj B ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; // integer m_A, n_A; integer m_B, n_B; integer cs_A; integer cs_B; - integer k_t; integer lwork; char blas_side; char blas_uplo; @@ -42,8 +41,6 @@ FLA_Error FLA_Tridiag_apply_Q_external( FLA_Side side, FLA_Uplo uplo, FLA_Trans n_B = FLA_Obj_width( B ); cs_B = FLA_Obj_col_stride( B ); - k_t = FLA_Obj_vector_dim( t ); - FLA_Param_map_flame_to_netlib_side( side, &blas_side ); FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo ); FLA_Param_map_flame_to_netlib_trans( trans, &blas_trans ); diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_blk_external.c index d1ae9db3b..7bebe22e7 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Tridiag_blk_external( FLA_Uplo uplo, FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_form_Q_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_form_Q_external.c index 45f6d5748..bff390947 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_form_Q_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_form_Q_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Tridiag_form_Q_external( FLA_Uplo uplo, FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_unb_external.c index 323fa1884..4d20f14cb 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Tridiag_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Tridiag_unb_external( FLA_Uplo uplo, FLA_Obj A, FLA_Obj t ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer n_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_blk_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_blk_external.c index 0acd5feab..d3b64b186 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_blk_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_blk_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Ttmm_blk_external( FLA_Uplo uplo, FLA_Obj A ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, cs_A; diff --git a/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_unb_external.c b/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_unb_external.c index fa865bb11..20e7bafb8 100644 --- a/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_unb_external.c +++ b/src/base/flamec/wrappers/lapack/external/FLA_Ttmm_unb_external.c @@ -12,7 +12,7 @@ FLA_Error FLA_Ttmm_unb_external( FLA_Uplo uplo, FLA_Obj A ) { - int info = 0; + integer info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; integer m_A, cs_A; diff --git a/src/flablas/f2c/cgbmv.c b/src/flablas/f2c/cgbmv.c index 8745a3e4b..fb8b00569 100644 --- a/src/flablas/f2c/cgbmv.c +++ b/src/flablas/f2c/cgbmv.c @@ -15,7 +15,7 @@ int cgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, comple extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj; integer kup1; /* .. Scalar Arguments .. */ @@ -161,7 +161,7 @@ int cgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, comple } if (info != 0) { - xerbla_("CGBMV ", &info); + xerbla_("CGBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cgemm.c b/src/flablas/f2c/cgemm.c index 8e388310c..f500f4580 100644 --- a/src/flablas/f2c/cgemm.c +++ b/src/flablas/f2c/cgemm.c @@ -18,7 +18,7 @@ int cgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, comp extern logical lsame_(char *, char *); integer nrowa, nrowb; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -191,7 +191,7 @@ int cgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, comp } if (info != 0) { - xerbla_("CGEMM ", &info); + xerbla_("CGEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cgemv.c b/src/flablas/f2c/cgemv.c index e83e94009..ef615da9f 100644 --- a/src/flablas/f2c/cgemv.c +++ b/src/flablas/f2c/cgemv.c @@ -15,7 +15,7 @@ int cgemv_(char *trans, integer *m, integer *n, complex * alpha, complex *a, int extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -130,7 +130,7 @@ int cgemv_(char *trans, integer *m, integer *n, complex * alpha, complex *a, int } if (info != 0) { - xerbla_("CGEMV ", &info); + xerbla_("CGEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cgerc.c b/src/flablas/f2c/cgerc.c index e62512518..a776549fe 100644 --- a/src/flablas/f2c/cgerc.c +++ b/src/flablas/f2c/cgerc.c @@ -13,7 +13,7 @@ int cgerc_(integer *m, integer *n, complex *alpha, complex * x, integer *incx, c complex temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -106,7 +106,7 @@ int cgerc_(integer *m, integer *n, complex *alpha, complex * x, integer *incx, c } if (info != 0) { - xerbla_("CGERC ", &info); + xerbla_("CGERC ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cgeru.c b/src/flablas/f2c/cgeru.c index 4f371606d..15d3655d1 100644 --- a/src/flablas/f2c/cgeru.c +++ b/src/flablas/f2c/cgeru.c @@ -11,7 +11,7 @@ int cgeru_(integer *m, integer *n, complex *alpha, complex * x, integer *incx, c complex temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -104,7 +104,7 @@ int cgeru_(integer *m, integer *n, complex *alpha, complex * x, integer *incx, c } if (info != 0) { - xerbla_("CGERU ", &info); + xerbla_("CGERU ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chbmv.c b/src/flablas/f2c/chbmv.c index df0968bb3..864c672c0 100644 --- a/src/flablas/f2c/chbmv.c +++ b/src/flablas/f2c/chbmv.c @@ -16,7 +16,7 @@ int chbmv_(char *uplo, integer *n, integer *k, complex * alpha, complex *a, inte extern logical lsame_(char *, char *); integer kplus1, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -157,7 +157,7 @@ int chbmv_(char *uplo, integer *n, integer *k, complex * alpha, complex *a, inte } if (info != 0) { - xerbla_("CHBMV ", &info); + xerbla_("CHBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chemm.c b/src/flablas/f2c/chemm.c index 7a8026a4f..a3223e329 100644 --- a/src/flablas/f2c/chemm.c +++ b/src/flablas/f2c/chemm.c @@ -17,7 +17,7 @@ int chemm_(char *side, char *uplo, integer *m, integer *n, complex *alpha, compl integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -178,7 +178,7 @@ int chemm_(char *side, char *uplo, integer *m, integer *n, complex *alpha, compl } if (info != 0) { - xerbla_("CHEMM ", &info); + xerbla_("CHEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chemv.c b/src/flablas/f2c/chemv.c index 8a230a257..50f9dbc94 100644 --- a/src/flablas/f2c/chemv.c +++ b/src/flablas/f2c/chemv.c @@ -16,7 +16,7 @@ int chemv_(char *uplo, integer *n, complex *alpha, complex * a, integer *lda, co extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -127,7 +127,7 @@ int chemv_(char *uplo, integer *n, complex *alpha, complex * a, integer *lda, co } if (info != 0) { - xerbla_("CHEMV ", &info); + xerbla_("CHEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cher.c b/src/flablas/f2c/cher.c index e858f47cb..9a6664215 100644 --- a/src/flablas/f2c/cher.c +++ b/src/flablas/f2c/cher.c @@ -16,7 +16,7 @@ int cher_(char *uplo, integer *n, real *alpha, complex *x, integer *incx, comple extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -113,7 +113,7 @@ int cher_(char *uplo, integer *n, real *alpha, complex *x, integer *incx, comple } if (info != 0) { - xerbla_("CHER ", &info); + xerbla_("CHER ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cher2.c b/src/flablas/f2c/cher2.c index e047a3731..22a1eb481 100644 --- a/src/flablas/f2c/cher2.c +++ b/src/flablas/f2c/cher2.c @@ -16,7 +16,7 @@ int cher2_(char *uplo, integer *n, complex *alpha, complex * x, integer *incx, c extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -127,7 +127,7 @@ int cher2_(char *uplo, integer *n, complex *alpha, complex * x, integer *incx, c } if (info != 0) { - xerbla_("CHER2 ", &info); + xerbla_("CHER2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cher2k.c b/src/flablas/f2c/cher2k.c index 8354794ea..4c7e0f0cb 100644 --- a/src/flablas/f2c/cher2k.c +++ b/src/flablas/f2c/cher2k.c @@ -17,7 +17,7 @@ int cher2k_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, com integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -181,7 +181,7 @@ int cher2k_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, com } if (info != 0) { - xerbla_("CHER2K", &info); + xerbla_("CHER2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/cherk.c b/src/flablas/f2c/cherk.c index 63482672a..a1b6b55b0 100644 --- a/src/flablas/f2c/cherk.c +++ b/src/flablas/f2c/cherk.c @@ -18,7 +18,7 @@ int cherk_(char *uplo, char *trans, integer *n, integer *k, real *alpha, complex real rtemp; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -158,7 +158,7 @@ int cherk_(char *uplo, char *trans, integer *n, integer *k, real *alpha, complex } if (info != 0) { - xerbla_("CHERK ", &info); + xerbla_("CHERK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chpmv.c b/src/flablas/f2c/chpmv.c index b415707b3..fe99a57b8 100644 --- a/src/flablas/f2c/chpmv.c +++ b/src/flablas/f2c/chpmv.c @@ -16,7 +16,7 @@ int chpmv_(char *uplo, integer *n, complex *alpha, complex * ap, complex *x, int extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -119,7 +119,7 @@ int chpmv_(char *uplo, integer *n, complex *alpha, complex * ap, complex *x, int } if (info != 0) { - xerbla_("CHPMV ", &info); + xerbla_("CHPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chpr.c b/src/flablas/f2c/chpr.c index 357bf3cd8..fdbf99dec 100644 --- a/src/flablas/f2c/chpr.c +++ b/src/flablas/f2c/chpr.c @@ -16,7 +16,7 @@ int chpr_(char *uplo, integer *n, real *alpha, complex *x, integer *incx, comple extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -105,7 +105,7 @@ int chpr_(char *uplo, integer *n, real *alpha, complex *x, integer *incx, comple } if (info != 0) { - xerbla_("CHPR ", &info); + xerbla_("CHPR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/chpr2.c b/src/flablas/f2c/chpr2.c index 6defd6a9c..28b7c7a84 100644 --- a/src/flablas/f2c/chpr2.c +++ b/src/flablas/f2c/chpr2.c @@ -16,7 +16,7 @@ int chpr2_(char *uplo, integer *n, complex *alpha, complex * x, integer *incx, c extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -119,7 +119,7 @@ int chpr2_(char *uplo, integer *n, complex *alpha, complex * x, integer *incx, c } if (info != 0) { - xerbla_("CHPR2 ", &info); + xerbla_("CHPR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/csymm.c b/src/flablas/f2c/csymm.c index 4a4dd819c..3e789dcb8 100644 --- a/src/flablas/f2c/csymm.c +++ b/src/flablas/f2c/csymm.c @@ -14,7 +14,7 @@ int csymm_(char *side, char *uplo, integer *m, integer *n, complex *alpha, compl integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -173,7 +173,7 @@ int csymm_(char *side, char *uplo, integer *m, integer *n, complex *alpha, compl } if (info != 0) { - xerbla_("CSYMM ", &info); + xerbla_("CSYMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/csyr2k.c b/src/flablas/f2c/csyr2k.c index bad821c99..05ad00197 100644 --- a/src/flablas/f2c/csyr2k.c +++ b/src/flablas/f2c/csyr2k.c @@ -14,7 +14,7 @@ int csyr2k_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, com integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -171,7 +171,7 @@ int csyr2k_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, com } if (info != 0) { - xerbla_("CSYR2K", &info); + xerbla_("CSYR2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/csyrk.c b/src/flablas/f2c/csyrk.c index f17b52154..2b06d06e9 100644 --- a/src/flablas/f2c/csyrk.c +++ b/src/flablas/f2c/csyrk.c @@ -14,7 +14,7 @@ int csyrk_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, comp integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -149,7 +149,7 @@ int csyrk_(char *uplo, char *trans, integer *n, integer *k, complex *alpha, comp } if (info != 0) { - xerbla_("CSYRK ", &info); + xerbla_("CSYRK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctbmv.c b/src/flablas/f2c/ctbmv.c index b77a9eb4d..0db08e648 100644 --- a/src/flablas/f2c/ctbmv.c +++ b/src/flablas/f2c/ctbmv.c @@ -15,7 +15,7 @@ int ctbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -161,7 +161,7 @@ int ctbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex } if (info != 0) { - xerbla_("CTBMV ", &info); + xerbla_("CTBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctbsv.c b/src/flablas/f2c/ctbsv.c index fe510df67..f904ba6c0 100644 --- a/src/flablas/f2c/ctbsv.c +++ b/src/flablas/f2c/ctbsv.c @@ -15,7 +15,7 @@ int ctbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -164,7 +164,7 @@ int ctbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, complex } if (info != 0) { - xerbla_("CTBSV ", &info); + xerbla_("CTBSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctpmv.c b/src/flablas/f2c/ctpmv.c index 096e2d0be..a0c5db0b0 100644 --- a/src/flablas/f2c/ctpmv.c +++ b/src/flablas/f2c/ctpmv.c @@ -15,7 +15,7 @@ int ctpmv_(char *uplo, char *trans, char *diag, integer *n, complex *ap, complex extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -117,7 +117,7 @@ int ctpmv_(char *uplo, char *trans, char *diag, integer *n, complex *ap, complex } if (info != 0) { - xerbla_("CTPMV ", &info); + xerbla_("CTPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctpsv.c b/src/flablas/f2c/ctpsv.c index ae411b9cf..2371d23f0 100644 --- a/src/flablas/f2c/ctpsv.c +++ b/src/flablas/f2c/ctpsv.c @@ -15,7 +15,7 @@ int ctpsv_(char *uplo, char *trans, char *diag, integer *n, complex *ap, complex extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -119,7 +119,7 @@ int ctpsv_(char *uplo, char *trans, char *diag, integer *n, complex *ap, complex } if (info != 0) { - xerbla_("CTPSV ", &info); + xerbla_("CTPSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctrmm.c b/src/flablas/f2c/ctrmm.c index 80a8d7c7b..b4a8c2b89 100644 --- a/src/flablas/f2c/ctrmm.c +++ b/src/flablas/f2c/ctrmm.c @@ -17,7 +17,7 @@ int ctrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -167,7 +167,7 @@ int ctrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("CTRMM ", &info); + xerbla_("CTRMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctrmv.c b/src/flablas/f2c/ctrmv.c index ff31f5741..1158b500a 100644 --- a/src/flablas/f2c/ctrmv.c +++ b/src/flablas/f2c/ctrmv.c @@ -15,7 +15,7 @@ int ctrmv_(char *uplo, char *trans, char *diag, integer *n, complex *a, integer extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -125,7 +125,7 @@ int ctrmv_(char *uplo, char *trans, char *diag, integer *n, complex *a, integer } if (info != 0) { - xerbla_("CTRMV ", &info); + xerbla_("CTRMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctrsm.c b/src/flablas/f2c/ctrsm.c index dbd810ae2..1261805c9 100644 --- a/src/flablas/f2c/ctrsm.c +++ b/src/flablas/f2c/ctrsm.c @@ -24,7 +24,7 @@ int ctrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -175,7 +175,7 @@ int ctrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("CTRSM ", &info); + xerbla_("CTRSM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ctrsv.c b/src/flablas/f2c/ctrsv.c index f50ae835a..7bfdf2cef 100644 --- a/src/flablas/f2c/ctrsv.c +++ b/src/flablas/f2c/ctrsv.c @@ -15,7 +15,7 @@ int ctrsv_(char *uplo, char *trans, char *diag, integer *n, complex *a, integer extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -127,7 +127,7 @@ int ctrsv_(char *uplo, char *trans, char *diag, integer *n, complex *a, integer } if (info != 0) { - xerbla_("CTRSV ", &info); + xerbla_("CTRSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dgbmv.c b/src/flablas/f2c/dgbmv.c index 3d1be7a56..4f99341ae 100644 --- a/src/flablas/f2c/dgbmv.c +++ b/src/flablas/f2c/dgbmv.c @@ -12,7 +12,7 @@ int dgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, double extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kup1; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -156,7 +156,7 @@ int dgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, double } if (info != 0) { - xerbla_("DGBMV ", &info); + xerbla_("DGBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dgemm.c b/src/flablas/f2c/dgemm.c index 35447dd17..2455df978 100644 --- a/src/flablas/f2c/dgemm.c +++ b/src/flablas/f2c/dgemm.c @@ -13,7 +13,7 @@ int dgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doub extern logical lsame_(char *, char *); integer nrowa, nrowb; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -182,7 +182,7 @@ int dgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doub } if (info != 0) { - xerbla_("DGEMM ", &info); + xerbla_("DGEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dgemv.c b/src/flablas/f2c/dgemv.c index b1452a1e3..0318f7d4b 100644 --- a/src/flablas/f2c/dgemv.c +++ b/src/flablas/f2c/dgemv.c @@ -12,7 +12,7 @@ int dgemv_(char *trans, integer *m, integer *n, doublereal * alpha, doublereal * extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -125,7 +125,7 @@ int dgemv_(char *trans, integer *m, integer *n, doublereal * alpha, doublereal * } if (info != 0) { - xerbla_("DGEMV ", &info); + xerbla_("DGEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dger.c b/src/flablas/f2c/dger.c index 3da4c4606..486e54557 100644 --- a/src/flablas/f2c/dger.c +++ b/src/flablas/f2c/dger.c @@ -10,7 +10,7 @@ int dger_(integer *m, integer *n, doublereal *alpha, doublereal *x, integer *inc doublereal temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -103,7 +103,7 @@ int dger_(integer *m, integer *n, doublereal *alpha, doublereal *x, integer *inc } if (info != 0) { - xerbla_("DGER ", &info); + xerbla_("DGER ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsbmv.c b/src/flablas/f2c/dsbmv.c index 0139b4a1e..37644f6cc 100644 --- a/src/flablas/f2c/dsbmv.c +++ b/src/flablas/f2c/dsbmv.c @@ -12,7 +12,7 @@ int dsbmv_(char *uplo, integer *n, integer *k, doublereal * alpha, doublereal *a extern logical lsame_(char *, char *); integer kplus1, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -151,7 +151,7 @@ int dsbmv_(char *uplo, integer *n, integer *k, doublereal * alpha, doublereal *a } if (info != 0) { - xerbla_("DSBMV ", &info); + xerbla_("DSBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dspmv.c b/src/flablas/f2c/dspmv.c index e6b838676..03a935aaa 100644 --- a/src/flablas/f2c/dspmv.c +++ b/src/flablas/f2c/dspmv.c @@ -12,7 +12,7 @@ int dspmv_(char *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -112,7 +112,7 @@ int dspmv_(char *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal } if (info != 0) { - xerbla_("DSPMV ", &info); + xerbla_("DSPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dspr.c b/src/flablas/f2c/dspr.c index cee164860..125353554 100644 --- a/src/flablas/f2c/dspr.c +++ b/src/flablas/f2c/dspr.c @@ -12,7 +12,7 @@ int dspr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *inc extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -97,7 +97,7 @@ int dspr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *inc } if (info != 0) { - xerbla_("DSPR ", &info); + xerbla_("DSPR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dspr2.c b/src/flablas/f2c/dspr2.c index ed745345a..2b39f89e6 100644 --- a/src/flablas/f2c/dspr2.c +++ b/src/flablas/f2c/dspr2.c @@ -12,7 +12,7 @@ int dspr2_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *in extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -111,7 +111,7 @@ int dspr2_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *in } if (info != 0) { - xerbla_("DSPR2 ", &info); + xerbla_("DSPR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsymm.c b/src/flablas/f2c/dsymm.c index e2d916300..66377bc54 100644 --- a/src/flablas/f2c/dsymm.c +++ b/src/flablas/f2c/dsymm.c @@ -13,7 +13,7 @@ int dsymm_(char *side, char *uplo, integer *m, integer *n, doublereal *alpha, do integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -172,7 +172,7 @@ int dsymm_(char *side, char *uplo, integer *m, integer *n, doublereal *alpha, do } if (info != 0) { - xerbla_("DSYMM ", &info); + xerbla_("DSYMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsymv.c b/src/flablas/f2c/dsymv.c index ce26a8876..1b9a361a4 100644 --- a/src/flablas/f2c/dsymv.c +++ b/src/flablas/f2c/dsymv.c @@ -12,7 +12,7 @@ int dsymv_(char *uplo, integer *n, doublereal *alpha, doublereal *a, integer *ld extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -121,7 +121,7 @@ int dsymv_(char *uplo, integer *n, doublereal *alpha, doublereal *a, integer *ld } if (info != 0) { - xerbla_("DSYMV ", &info); + xerbla_("DSYMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsyr.c b/src/flablas/f2c/dsyr.c index d08716083..d273e6861 100644 --- a/src/flablas/f2c/dsyr.c +++ b/src/flablas/f2c/dsyr.c @@ -12,7 +12,7 @@ int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *inc extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -106,7 +106,7 @@ int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *inc } if (info != 0) { - xerbla_("DSYR ", &info); + xerbla_("DSYR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsyr2.c b/src/flablas/f2c/dsyr2.c index 528685650..9865bd146 100644 --- a/src/flablas/f2c/dsyr2.c +++ b/src/flablas/f2c/dsyr2.c @@ -12,7 +12,7 @@ int dsyr2_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *in extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -120,7 +120,7 @@ int dsyr2_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *in } if (info != 0) { - xerbla_("DSYR2 ", &info); + xerbla_("DSYR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsyr2k.c b/src/flablas/f2c/dsyr2k.c index 69dbf1652..1f10ae0a0 100644 --- a/src/flablas/f2c/dsyr2k.c +++ b/src/flablas/f2c/dsyr2k.c @@ -13,7 +13,7 @@ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -172,7 +172,7 @@ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, } if (info != 0) { - xerbla_("DSYR2K", &info); + xerbla_("DSYR2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dsyrk.c b/src/flablas/f2c/dsyrk.c index 531ddb541..9b5a41f3e 100644 --- a/src/flablas/f2c/dsyrk.c +++ b/src/flablas/f2c/dsyrk.c @@ -13,7 +13,7 @@ int dsyrk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -149,7 +149,7 @@ int dsyrk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d } if (info != 0) { - xerbla_("DSYRK ", &info); + xerbla_("DSYRK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtbmv.c b/src/flablas/f2c/dtbmv.c index b60e1f132..88cfc44c9 100644 --- a/src/flablas/f2c/dtbmv.c +++ b/src/flablas/f2c/dtbmv.c @@ -12,7 +12,7 @@ int dtbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublere extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -158,7 +158,7 @@ int dtbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublere } if (info != 0) { - xerbla_("DTBMV ", &info); + xerbla_("DTBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtbsv.c b/src/flablas/f2c/dtbsv.c index b1cfdb2cd..fa19ebb43 100644 --- a/src/flablas/f2c/dtbsv.c +++ b/src/flablas/f2c/dtbsv.c @@ -12,7 +12,7 @@ int dtbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublere extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -161,7 +161,7 @@ int dtbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doublere } if (info != 0) { - xerbla_("DTBSV ", &info); + xerbla_("DTBSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtpmv.c b/src/flablas/f2c/dtpmv.c index f257eee0f..975116524 100644 --- a/src/flablas/f2c/dtpmv.c +++ b/src/flablas/f2c/dtpmv.c @@ -12,7 +12,7 @@ int dtpmv_(char *uplo, char *trans, char *diag, integer *n, doublereal *ap, doub extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -113,7 +113,7 @@ int dtpmv_(char *uplo, char *trans, char *diag, integer *n, doublereal *ap, doub } if (info != 0) { - xerbla_("DTPMV ", &info); + xerbla_("DTPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtpsv.c b/src/flablas/f2c/dtpsv.c index 56726e0af..e6d19863f 100644 --- a/src/flablas/f2c/dtpsv.c +++ b/src/flablas/f2c/dtpsv.c @@ -12,7 +12,7 @@ int dtpsv_(char *uplo, char *trans, char *diag, integer *n, doublereal *ap, doub extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -115,7 +115,7 @@ int dtpsv_(char *uplo, char *trans, char *diag, integer *n, doublereal *ap, doub } if (info != 0) { - xerbla_("DTPSV ", &info); + xerbla_("DTPSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtrmm.c b/src/flablas/f2c/dtrmm.c index 12b3fd29e..277bfe156 100644 --- a/src/flablas/f2c/dtrmm.c +++ b/src/flablas/f2c/dtrmm.c @@ -14,7 +14,7 @@ int dtrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -163,7 +163,7 @@ int dtrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("DTRMM ", &info); + xerbla_("DTRMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtrmv.c b/src/flablas/f2c/dtrmv.c index 45d297647..7fd0d47dd 100644 --- a/src/flablas/f2c/dtrmv.c +++ b/src/flablas/f2c/dtrmv.c @@ -12,7 +12,7 @@ int dtrmv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integ extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -122,7 +122,7 @@ int dtrmv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integ } if (info != 0) { - xerbla_("DTRMV ", &info); + xerbla_("DTRMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtrsm.c b/src/flablas/f2c/dtrsm.c index 626db60cf..3b9349a20 100644 --- a/src/flablas/f2c/dtrsm.c +++ b/src/flablas/f2c/dtrsm.c @@ -15,7 +15,7 @@ int dtrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -165,7 +165,7 @@ int dtrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("DTRSM ", &info); + xerbla_("DTRSM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/dtrsv.c b/src/flablas/f2c/dtrsv.c index ee1119f45..85f43ca50 100644 --- a/src/flablas/f2c/dtrsv.c +++ b/src/flablas/f2c/dtrsv.c @@ -12,7 +12,7 @@ int dtrsv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integ extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -124,7 +124,7 @@ int dtrsv_(char *uplo, char *trans, char *diag, integer *n, doublereal *a, integ } if (info != 0) { - xerbla_("DTRSV ", &info); + xerbla_("DTRSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/other/static/xerbla.c b/src/flablas/f2c/other/static/xerbla.c index 767593a62..fc7010fdd 100644 --- a/src/flablas/f2c/other/static/xerbla.c +++ b/src/flablas/f2c/other/static/xerbla.c @@ -2,7 +2,7 @@ #include "FLA_f2c.h" #include "stdio.h" /* Table of constant values */ /* Subroutine */ - int xerbla_(char *srname, integer *info) { + int xerbla_(const char *srname, const integer *info, ftnlen srname_len) { /* -- LAPACK auxiliary routine (preliminary version) -- */ /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ /* Courant Institute, Argonne National Lab, and Rice University */ diff --git a/src/flablas/f2c/sgbmv.c b/src/flablas/f2c/sgbmv.c index 9de254b08..ec987f0d9 100644 --- a/src/flablas/f2c/sgbmv.c +++ b/src/flablas/f2c/sgbmv.c @@ -12,7 +12,7 @@ int sgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, real * extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kup1; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -156,7 +156,7 @@ int sgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, real * } if (info != 0) { - xerbla_("SGBMV ", &info); + xerbla_("SGBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sgemm.c b/src/flablas/f2c/sgemm.c index 640dff368..47bc7da97 100644 --- a/src/flablas/f2c/sgemm.c +++ b/src/flablas/f2c/sgemm.c @@ -13,7 +13,7 @@ int sgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, real extern logical lsame_(char *, char *); integer nrowa, nrowb; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -182,7 +182,7 @@ int sgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, real } if (info != 0) { - xerbla_("SGEMM ", &info); + xerbla_("SGEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sgemv.c b/src/flablas/f2c/sgemv.c index 829da5e06..b4434c9f9 100644 --- a/src/flablas/f2c/sgemv.c +++ b/src/flablas/f2c/sgemv.c @@ -12,7 +12,7 @@ int sgemv_(char *trans, integer *m, integer *n, real *alpha, real *a, integer *l extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -125,7 +125,7 @@ int sgemv_(char *trans, integer *m, integer *n, real *alpha, real *a, integer *l } if (info != 0) { - xerbla_("SGEMV ", &info); + xerbla_("SGEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sger.c b/src/flablas/f2c/sger.c index 6b10890b5..22b5307bd 100644 --- a/src/flablas/f2c/sger.c +++ b/src/flablas/f2c/sger.c @@ -10,7 +10,7 @@ int sger_(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, real temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -103,7 +103,7 @@ int sger_(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, } if (info != 0) { - xerbla_("SGER ", &info); + xerbla_("SGER ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssbmv.c b/src/flablas/f2c/ssbmv.c index b48314a04..0f531f356 100644 --- a/src/flablas/f2c/ssbmv.c +++ b/src/flablas/f2c/ssbmv.c @@ -12,7 +12,7 @@ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha, real *a, integer *ld extern logical lsame_(char *, char *); integer kplus1, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -151,7 +151,7 @@ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha, real *a, integer *ld } if (info != 0) { - xerbla_("SSBMV ", &info); + xerbla_("SSBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sspmv.c b/src/flablas/f2c/sspmv.c index ece6ec79c..7200c1215 100644 --- a/src/flablas/f2c/sspmv.c +++ b/src/flablas/f2c/sspmv.c @@ -12,7 +12,7 @@ int sspmv_(char *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -112,7 +112,7 @@ int sspmv_(char *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx } if (info != 0) { - xerbla_("SSPMV ", &info); + xerbla_("SSPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sspr.c b/src/flablas/f2c/sspr.c index 960025b24..f1e2c463c 100644 --- a/src/flablas/f2c/sspr.c +++ b/src/flablas/f2c/sspr.c @@ -12,7 +12,7 @@ int sspr_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *ap) extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -97,7 +97,7 @@ int sspr_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *ap) } if (info != 0) { - xerbla_("SSPR ", &info); + xerbla_("SSPR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/sspr2.c b/src/flablas/f2c/sspr2.c index 5a2cd5161..862e3062a 100644 --- a/src/flablas/f2c/sspr2.c +++ b/src/flablas/f2c/sspr2.c @@ -12,7 +12,7 @@ int sspr2_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -111,7 +111,7 @@ int sspr2_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, } if (info != 0) { - xerbla_("SSPR2 ", &info); + xerbla_("SSPR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssymm.c b/src/flablas/f2c/ssymm.c index 3113fb92e..11401e163 100644 --- a/src/flablas/f2c/ssymm.c +++ b/src/flablas/f2c/ssymm.c @@ -13,7 +13,7 @@ int ssymm_(char *side, char *uplo, integer *m, integer *n, real *alpha, real *a, integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -172,7 +172,7 @@ int ssymm_(char *side, char *uplo, integer *m, integer *n, real *alpha, real *a, } if (info != 0) { - xerbla_("SSYMM ", &info); + xerbla_("SSYMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssymv.c b/src/flablas/f2c/ssymv.c index a89981ef2..a0fdae385 100644 --- a/src/flablas/f2c/ssymv.c +++ b/src/flablas/f2c/ssymv.c @@ -12,7 +12,7 @@ int ssymv_(char *uplo, integer *n, real *alpha, real *a, integer *lda, real *x, extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -121,7 +121,7 @@ int ssymv_(char *uplo, integer *n, real *alpha, real *a, integer *lda, real *x, } if (info != 0) { - xerbla_("SSYMV ", &info); + xerbla_("SSYMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssyr.c b/src/flablas/f2c/ssyr.c index 10c217630..64890b8cb 100644 --- a/src/flablas/f2c/ssyr.c +++ b/src/flablas/f2c/ssyr.c @@ -12,7 +12,7 @@ int ssyr_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *a, extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -106,7 +106,7 @@ int ssyr_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *a, } if (info != 0) { - xerbla_("SSYR ", &info); + xerbla_("SSYR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssyr2.c b/src/flablas/f2c/ssyr2.c index c05b4babf..d9e5aebcd 100644 --- a/src/flablas/f2c/ssyr2.c +++ b/src/flablas/f2c/ssyr2.c @@ -12,7 +12,7 @@ int ssyr2_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -120,7 +120,7 @@ int ssyr2_(char *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, } if (info != 0) { - xerbla_("SSYR2 ", &info); + xerbla_("SSYR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssyr2k.c b/src/flablas/f2c/ssyr2k.c index cf4db8a9a..28e9ff04d 100644 --- a/src/flablas/f2c/ssyr2k.c +++ b/src/flablas/f2c/ssyr2k.c @@ -13,7 +13,7 @@ int ssyr2k_(char *uplo, char *trans, integer *n, integer *k, real *alpha, real * integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -172,7 +172,7 @@ int ssyr2k_(char *uplo, char *trans, integer *n, integer *k, real *alpha, real * } if (info != 0) { - xerbla_("SSYR2K", &info); + xerbla_("SSYR2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ssyrk.c b/src/flablas/f2c/ssyrk.c index 63ee9e5c5..ebb94266a 100644 --- a/src/flablas/f2c/ssyrk.c +++ b/src/flablas/f2c/ssyrk.c @@ -13,7 +13,7 @@ int ssyrk_(char *uplo, char *trans, integer *n, integer *k, real *alpha, real *a integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -149,7 +149,7 @@ int ssyrk_(char *uplo, char *trans, integer *n, integer *k, real *alpha, real *a } if (info != 0) { - xerbla_("SSYRK ", &info); + xerbla_("SSYRK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/stbmv.c b/src/flablas/f2c/stbmv.c index 2c9090fe8..15becaa44 100644 --- a/src/flablas/f2c/stbmv.c +++ b/src/flablas/f2c/stbmv.c @@ -12,7 +12,7 @@ int stbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -158,7 +158,7 @@ int stbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, } if (info != 0) { - xerbla_("STBMV ", &info); + xerbla_("STBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/stbsv.c b/src/flablas/f2c/stbsv.c index c2f97b7b1..97b79d402 100644 --- a/src/flablas/f2c/stbsv.c +++ b/src/flablas/f2c/stbsv.c @@ -12,7 +12,7 @@ int stbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -161,7 +161,7 @@ int stbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, real *a, } if (info != 0) { - xerbla_("STBSV ", &info); + xerbla_("STBSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/stpmv.c b/src/flablas/f2c/stpmv.c index 9daf141e9..f0bedd550 100644 --- a/src/flablas/f2c/stpmv.c +++ b/src/flablas/f2c/stpmv.c @@ -12,7 +12,7 @@ int stpmv_(char *uplo, char *trans, char *diag, integer *n, real *ap, real *x, i extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -113,7 +113,7 @@ int stpmv_(char *uplo, char *trans, char *diag, integer *n, real *ap, real *x, i } if (info != 0) { - xerbla_("STPMV ", &info); + xerbla_("STPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/stpsv.c b/src/flablas/f2c/stpsv.c index a45d3575d..b93b80c30 100644 --- a/src/flablas/f2c/stpsv.c +++ b/src/flablas/f2c/stpsv.c @@ -12,7 +12,7 @@ int stpsv_(char *uplo, char *trans, char *diag, integer *n, real *ap, real *x, i extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -115,7 +115,7 @@ int stpsv_(char *uplo, char *trans, char *diag, integer *n, real *ap, real *x, i } if (info != 0) { - xerbla_("STPSV ", &info); + xerbla_("STPSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/strmm.c b/src/flablas/f2c/strmm.c index 856b5df21..1a7ab913f 100644 --- a/src/flablas/f2c/strmm.c +++ b/src/flablas/f2c/strmm.c @@ -14,7 +14,7 @@ int strmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -163,7 +163,7 @@ int strmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("STRMM ", &info); + xerbla_("STRMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/strmv.c b/src/flablas/f2c/strmv.c index 503032664..eb0ed7a96 100644 --- a/src/flablas/f2c/strmv.c +++ b/src/flablas/f2c/strmv.c @@ -12,7 +12,7 @@ int strmv_(char *uplo, char *trans, char *diag, integer *n, real *a, integer *ld extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -122,7 +122,7 @@ int strmv_(char *uplo, char *trans, char *diag, integer *n, real *a, integer *ld } if (info != 0) { - xerbla_("STRMV ", &info); + xerbla_("STRMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/strsm.c b/src/flablas/f2c/strsm.c index c5cb42d9a..aeba94bac 100644 --- a/src/flablas/f2c/strsm.c +++ b/src/flablas/f2c/strsm.c @@ -15,7 +15,7 @@ int strsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -165,7 +165,7 @@ int strsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("STRSM ", &info); + xerbla_("STRSM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/strsv.c b/src/flablas/f2c/strsv.c index de9feb19f..db14d900a 100644 --- a/src/flablas/f2c/strsv.c +++ b/src/flablas/f2c/strsv.c @@ -12,7 +12,7 @@ int strsv_(char *uplo, char *trans, char *diag, integer *n, real *a, integer *ld extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -124,7 +124,7 @@ int strsv_(char *uplo, char *trans, char *diag, integer *n, real *a, integer *ld } if (info != 0) { - xerbla_("STRSV ", &info); + xerbla_("STRSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zgbmv.c b/src/flablas/f2c/zgbmv.c index a30002b09..83faa1eaa 100644 --- a/src/flablas/f2c/zgbmv.c +++ b/src/flablas/f2c/zgbmv.c @@ -15,7 +15,7 @@ int zgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, double extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj; integer kup1; /* .. Scalar Arguments .. */ @@ -161,7 +161,7 @@ int zgbmv_(char *trans, integer *m, integer *n, integer *kl, integer *ku, double } if (info != 0) { - xerbla_("ZGBMV ", &info); + xerbla_("ZGBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zgemm.c b/src/flablas/f2c/zgemm.c index 6d185200c..c815ddf72 100644 --- a/src/flablas/f2c/zgemm.c +++ b/src/flablas/f2c/zgemm.c @@ -18,7 +18,7 @@ int zgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doub extern logical lsame_(char *, char *); integer nrowa, nrowb; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -191,7 +191,7 @@ int zgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doub } if (info != 0) { - xerbla_("ZGEMM ", &info); + xerbla_("ZGEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zgemv.c b/src/flablas/f2c/zgemv.c index 9a8ba1156..b250d2d08 100644 --- a/src/flablas/f2c/zgemv.c +++ b/src/flablas/f2c/zgemv.c @@ -15,7 +15,7 @@ int zgemv_(char *trans, integer *m, integer *n, doublecomplex *alpha, doublecomp extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -130,7 +130,7 @@ int zgemv_(char *trans, integer *m, integer *n, doublecomplex *alpha, doublecomp } if (info != 0) { - xerbla_("ZGEMV ", &info); + xerbla_("ZGEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zgerc.c b/src/flablas/f2c/zgerc.c index 867a4692e..39dc006e6 100644 --- a/src/flablas/f2c/zgerc.c +++ b/src/flablas/f2c/zgerc.c @@ -13,7 +13,7 @@ int zgerc_(integer *m, integer *n, doublecomplex *alpha, doublecomplex *x, integ doublecomplex temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -106,7 +106,7 @@ int zgerc_(integer *m, integer *n, doublecomplex *alpha, doublecomplex *x, integ } if (info != 0) { - xerbla_("ZGERC ", &info); + xerbla_("ZGERC ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zgeru.c b/src/flablas/f2c/zgeru.c index 134ccb3b5..bcb928437 100644 --- a/src/flablas/f2c/zgeru.c +++ b/src/flablas/f2c/zgeru.c @@ -11,7 +11,7 @@ int zgeru_(integer *m, integer *n, doublecomplex *alpha, doublecomplex *x, integ doublecomplex temp; integer i__, j, ix, jy, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -104,7 +104,7 @@ int zgeru_(integer *m, integer *n, doublecomplex *alpha, doublecomplex *x, integ } if (info != 0) { - xerbla_("ZGERU ", &info); + xerbla_("ZGERU ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhbmv.c b/src/flablas/f2c/zhbmv.c index 6770daa99..03f1ae44d 100644 --- a/src/flablas/f2c/zhbmv.c +++ b/src/flablas/f2c/zhbmv.c @@ -16,7 +16,7 @@ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex *alpha, doublecompl extern logical lsame_(char *, char *); integer kplus1, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -157,7 +157,7 @@ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex *alpha, doublecompl } if (info != 0) { - xerbla_("ZHBMV ", &info); + xerbla_("ZHBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhemm.c b/src/flablas/f2c/zhemm.c index cc1e76299..6aee6d5f0 100644 --- a/src/flablas/f2c/zhemm.c +++ b/src/flablas/f2c/zhemm.c @@ -17,7 +17,7 @@ int zhemm_(char *side, char *uplo, integer *m, integer *n, doublecomplex *alpha, integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -178,7 +178,7 @@ int zhemm_(char *side, char *uplo, integer *m, integer *n, doublecomplex *alpha, } if (info != 0) { - xerbla_("ZHEMM ", &info); + xerbla_("ZHEMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhemv.c b/src/flablas/f2c/zhemv.c index 2511c5bed..35cf47b05 100644 --- a/src/flablas/f2c/zhemv.c +++ b/src/flablas/f2c/zhemv.c @@ -16,7 +16,7 @@ int zhemv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *a, integ extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -127,7 +127,7 @@ int zhemv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *a, integ } if (info != 0) { - xerbla_("ZHEMV ", &info); + xerbla_("ZHEMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zher.c b/src/flablas/f2c/zher.c index 4d29d7974..b70824e1f 100644 --- a/src/flablas/f2c/zher.c +++ b/src/flablas/f2c/zher.c @@ -16,7 +16,7 @@ int zher_(char *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer * extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -113,7 +113,7 @@ int zher_(char *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer * } if (info != 0) { - xerbla_("ZHER ", &info); + xerbla_("ZHER ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zher2.c b/src/flablas/f2c/zher2.c index 4fcf507ba..75e74aa46 100644 --- a/src/flablas/f2c/zher2.c +++ b/src/flablas/f2c/zher2.c @@ -16,7 +16,7 @@ int zher2_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integ extern logical lsame_(char *, char *); integer ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -127,7 +127,7 @@ int zher2_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integ } if (info != 0) { - xerbla_("ZHER2 ", &info); + xerbla_("ZHER2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zher2k.c b/src/flablas/f2c/zher2k.c index 952008871..c3297708a 100644 --- a/src/flablas/f2c/zher2k.c +++ b/src/flablas/f2c/zher2k.c @@ -17,7 +17,7 @@ int zher2k_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alph integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ @@ -186,7 +186,7 @@ int zher2k_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alph } if (info != 0) { - xerbla_("ZHER2K", &info); + xerbla_("ZHER2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zherk.c b/src/flablas/f2c/zherk.c index d7ab04d93..3be6d7e5e 100644 --- a/src/flablas/f2c/zherk.c +++ b/src/flablas/f2c/zherk.c @@ -18,7 +18,7 @@ int zherk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d doublereal rtemp; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ @@ -163,7 +163,7 @@ int zherk_(char *uplo, char *trans, integer *n, integer *k, doublereal *alpha, d } if (info != 0) { - xerbla_("ZHERK ", &info); + xerbla_("ZHERK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhpmv.c b/src/flablas/f2c/zhpmv.c index d8a1c6054..e392b93dd 100644 --- a/src/flablas/f2c/zhpmv.c +++ b/src/flablas/f2c/zhpmv.c @@ -16,7 +16,7 @@ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doub extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -119,7 +119,7 @@ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doub } if (info != 0) { - xerbla_("ZHPMV ", &info); + xerbla_("ZHPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhpr.c b/src/flablas/f2c/zhpr.c index 17aedc714..096a60314 100644 --- a/src/flablas/f2c/zhpr.c +++ b/src/flablas/f2c/zhpr.c @@ -16,7 +16,7 @@ int zhpr_(char *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer * extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -105,7 +105,7 @@ int zhpr_(char *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer * } if (info != 0) { - xerbla_("ZHPR ", &info); + xerbla_("ZHPR ", &info, (ftnlen)5); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zhpr2.c b/src/flablas/f2c/zhpr2.c index 4c77d357a..680ae94b2 100644 --- a/src/flablas/f2c/zhpr2.c +++ b/src/flablas/f2c/zhpr2.c @@ -16,7 +16,7 @@ int zhpr2_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integ extern logical lsame_(char *, char *); integer kk, ix, iy, jx, jy, kx, ky; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -119,7 +119,7 @@ int zhpr2_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integ } if (info != 0) { - xerbla_("ZHPR2 ", &info); + xerbla_("ZHPR2 ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zsymm.c b/src/flablas/f2c/zsymm.c index a13c37d30..bbb0c079d 100644 --- a/src/flablas/f2c/zsymm.c +++ b/src/flablas/f2c/zsymm.c @@ -14,7 +14,7 @@ int zsymm_(char *side, char *uplo, integer *m, integer *n, doublecomplex *alpha, integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -173,7 +173,7 @@ int zsymm_(char *side, char *uplo, integer *m, integer *n, doublecomplex *alpha, } if (info != 0) { - xerbla_("ZSYMM ", &info); + xerbla_("ZSYMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zsyr2k.c b/src/flablas/f2c/zsyr2k.c index e655e66bb..38b7a2ed6 100644 --- a/src/flablas/f2c/zsyr2k.c +++ b/src/flablas/f2c/zsyr2k.c @@ -14,7 +14,7 @@ int zsyr2k_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alph integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -171,7 +171,7 @@ int zsyr2k_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alph } if (info != 0) { - xerbla_("ZSYR2K", &info); + xerbla_("ZSYR2K", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/zsyrk.c b/src/flablas/f2c/zsyrk.c index 56632c5ce..0c58ca569 100644 --- a/src/flablas/f2c/zsyrk.c +++ b/src/flablas/f2c/zsyrk.c @@ -14,7 +14,7 @@ int zsyrk_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alpha integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ /* .. */ @@ -149,7 +149,7 @@ int zsyrk_(char *uplo, char *trans, integer *n, integer *k, doublecomplex *alpha } if (info != 0) { - xerbla_("ZSYRK ", &info); + xerbla_("ZSYRK ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztbmv.c b/src/flablas/f2c/ztbmv.c index bd8695a01..d75832fd8 100644 --- a/src/flablas/f2c/ztbmv.c +++ b/src/flablas/f2c/ztbmv.c @@ -15,7 +15,7 @@ int ztbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doubleco extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -161,7 +161,7 @@ int ztbmv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doubleco } if (info != 0) { - xerbla_("ZTBMV ", &info); + xerbla_("ZTBMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztbsv.c b/src/flablas/f2c/ztbsv.c index 932aa38c8..71082f2e4 100644 --- a/src/flablas/f2c/ztbsv.c +++ b/src/flablas/f2c/ztbsv.c @@ -15,7 +15,7 @@ int ztbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doubleco extern logical lsame_(char *, char *); integer kplus1, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -164,7 +164,7 @@ int ztbsv_(char *uplo, char *trans, char *diag, integer *n, integer *k, doubleco } if (info != 0) { - xerbla_("ZTBSV ", &info); + xerbla_("ZTBSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztpmv.c b/src/flablas/f2c/ztpmv.c index b1da31d50..d9232dea8 100644 --- a/src/flablas/f2c/ztpmv.c +++ b/src/flablas/f2c/ztpmv.c @@ -15,7 +15,7 @@ int ztpmv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *ap, d extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -117,7 +117,7 @@ int ztpmv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *ap, d } if (info != 0) { - xerbla_("ZTPMV ", &info); + xerbla_("ZTPMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztpsv.c b/src/flablas/f2c/ztpsv.c index f7305fc71..90fa6ae17 100644 --- a/src/flablas/f2c/ztpsv.c +++ b/src/flablas/f2c/ztpsv.c @@ -15,7 +15,7 @@ int ztpsv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *ap, d extern logical lsame_(char *, char *); integer kk, ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -119,7 +119,7 @@ int ztpsv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *ap, d } if (info != 0) { - xerbla_("ZTPSV ", &info); + xerbla_("ZTPSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztrmm.c b/src/flablas/f2c/ztrmm.c index 0caa334e2..3ed9e1f89 100644 --- a/src/flablas/f2c/ztrmm.c +++ b/src/flablas/f2c/ztrmm.c @@ -17,7 +17,7 @@ int ztrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -167,7 +167,7 @@ int ztrmm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("ZTRMM ", &info); + xerbla_("ZTRMM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztrmv.c b/src/flablas/f2c/ztrmv.c index 9ad835c43..56f174372 100644 --- a/src/flablas/f2c/ztrmv.c +++ b/src/flablas/f2c/ztrmv.c @@ -15,7 +15,7 @@ int ztrmv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *a, in extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -125,7 +125,7 @@ int ztrmv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *a, in } if (info != 0) { - xerbla_("ZTRMV ", &info); + xerbla_("ZTRMV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztrsm.c b/src/flablas/f2c/ztrsm.c index ba39b867b..824baf258 100644 --- a/src/flablas/f2c/ztrsm.c +++ b/src/flablas/f2c/ztrsm.c @@ -24,7 +24,7 @@ int ztrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer integer nrowa; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -175,7 +175,7 @@ int ztrsm_(char *side, char *uplo, char *transa, char *diag, integer *m, integer } if (info != 0) { - xerbla_("ZTRSM ", &info); + xerbla_("ZTRSM ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/flablas/f2c/ztrsv.c b/src/flablas/f2c/ztrsv.c index adfaaa5d0..51ca1e456 100644 --- a/src/flablas/f2c/ztrsv.c +++ b/src/flablas/f2c/ztrsv.c @@ -15,7 +15,7 @@ int ztrsv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *a, in extern logical lsame_(char *, char *); integer ix, jx, kx; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconj, nounit; /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -127,7 +127,7 @@ int ztrsv_(char *uplo, char *trans, char *diag, integer *n, doublecomplex *a, in } if (info != 0) { - xerbla_("ZTRSV ", &info); + xerbla_("ZTRSV ", &info, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/lapack/dec/bsvd/ext/flamec/FLA_Bsvd_ext_opt_var1.c b/src/lapack/dec/bsvd/ext/flamec/FLA_Bsvd_ext_opt_var1.c index 8a01bffc9..63b6b0125 100644 --- a/src/lapack/dec/bsvd/ext/flamec/FLA_Bsvd_ext_opt_var1.c +++ b/src/lapack/dec/bsvd/ext/flamec/FLA_Bsvd_ext_opt_var1.c @@ -266,8 +266,6 @@ FLA_Error FLA_Bsvd_ext_ops_var1( integer m_d, integer m_A11; integer n_iter_perf; integer n_UV_apply; - integer total_deflations; - integer n_deflations; integer n_iter_prev; integer n_iter_perf_sweep_max; @@ -293,7 +291,7 @@ FLA_Error FLA_Bsvd_ext_ops_var1( integer m_d, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for ( ; done != TRUE; ) { // Initialize G and H to contain only identity rotations. @@ -378,7 +376,7 @@ FLA_Error FLA_Bsvd_ext_ops_var1( integer m_d, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_ops_var1( m_A11, + FLA_Bsvd_iteracc_v_ops_var1( m_A11, n_GH, ijTL, tol, @@ -389,9 +387,6 @@ FLA_Error FLA_Bsvd_ext_ops_var1( integer m_d, H, rs_H, cs_H, &n_iter_perf ); - // Record the number of deflations that were observed. - total_deflations += n_deflations; - // Update the maximum number of iterations performed in the // current sweep. n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); @@ -521,8 +516,6 @@ FLA_Error FLA_Bsvd_ext_opd_var1( integer m_d, integer m_A11; integer n_iter_perf; integer n_UV_apply; - integer total_deflations; - integer n_deflations; integer n_iter_prev; integer n_iter_perf_sweep_max; @@ -548,7 +541,7 @@ FLA_Error FLA_Bsvd_ext_opd_var1( integer m_d, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for ( ; done != TRUE; ) { // Initialize G and H to contain only identity rotations. @@ -632,7 +625,7 @@ FLA_Error FLA_Bsvd_ext_opd_var1( integer m_d, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, + FLA_Bsvd_iteracc_v_opd_var1( m_A11, n_GH, ijTL, tol, @@ -643,9 +636,6 @@ FLA_Error FLA_Bsvd_ext_opd_var1( integer m_d, H, rs_H, cs_H, &n_iter_perf ); - // Record the number of deflations that were observed. - total_deflations += n_deflations; - // Update the maximum number of iterations performed in the // current sweep. n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); @@ -773,8 +763,6 @@ FLA_Error FLA_Bsvd_ext_opc_var1( integer m_d, integer m_A11; integer n_iter_perf; integer n_UV_apply; - integer total_deflations; - integer n_deflations; integer n_iter_prev; integer n_iter_perf_sweep_max; @@ -800,7 +788,7 @@ FLA_Error FLA_Bsvd_ext_opc_var1( integer m_d, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for ( ; done != TRUE; ) { // Initialize G and H to contain only identity rotations. @@ -884,7 +872,7 @@ FLA_Error FLA_Bsvd_ext_opc_var1( integer m_d, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_ops_var1( m_A11, + FLA_Bsvd_iteracc_v_ops_var1( m_A11, n_GH, ijTL, tol, @@ -895,9 +883,6 @@ FLA_Error FLA_Bsvd_ext_opc_var1( integer m_d, H, rs_H, cs_H, &n_iter_perf ); - // Record the number of deflations that were observed. - total_deflations += n_deflations; - // Update the maximum number of iterations performed in the // current sweep. n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); @@ -1024,8 +1009,6 @@ FLA_Error FLA_Bsvd_ext_opz_var1( integer m_d, integer m_A11; integer n_iter_perf; integer n_UV_apply; - integer total_deflations; - integer n_deflations; integer n_iter_prev; integer n_iter_perf_sweep_max; @@ -1051,7 +1034,7 @@ FLA_Error FLA_Bsvd_ext_opz_var1( integer m_d, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for ( ; done != TRUE; ) { // Initialize G and H to contain only identity rotations. @@ -1135,7 +1118,7 @@ FLA_Error FLA_Bsvd_ext_opz_var1( integer m_d, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, + FLA_Bsvd_iteracc_v_opd_var1( m_A11, n_GH, ijTL, tol, @@ -1146,9 +1129,6 @@ FLA_Error FLA_Bsvd_ext_opz_var1( integer m_d, H, rs_H, cs_H, &n_iter_perf ); - // Record the number of deflations that were observed. - total_deflations += n_deflations; - // Update the maximum number of iterations performed in the // current sweep. n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); @@ -1164,7 +1144,6 @@ FLA_Error FLA_Bsvd_ext_opz_var1( integer m_d, if ( n_iter_prev >= n_iter_max * m_d ) { FLA_Abort(); - //return FLA_FAILURE; } } diff --git a/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var1.c b/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var1.c index 0fba55bf7..6c42c86d3 100644 --- a/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var1.c +++ b/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var1.c @@ -12,138 +12,137 @@ // Note that this operation is designed for tall rectangular matrix A. // If m_A < n_A then, U and V should be swapped before entering this function. -FLA_Error FLA_Bsvd_v_opt_var1( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj H, FLA_Obj U, FLA_Obj V, dim_t b_alg ) +FLA_Error FLA_Bsvd_v_opt_var1(dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj H, FLA_Obj U, FLA_Obj V, dim_t b_alg) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype datatype; - integer m_U, m_V, n_GH; - integer inc_d; - integer inc_e; - integer rs_G, cs_G; - integer rs_H, cs_H; - integer rs_U, cs_U; - integer rs_V, cs_V; + integer m_U, m_V, n_GH; + integer inc_d; + integer inc_e; + integer rs_G, cs_G; + integer rs_H, cs_H; + integer rs_U, cs_U; + integer rs_V, cs_V; - datatype = FLA_Obj_datatype( U ); + datatype = FLA_Obj_datatype(U); - m_U = FLA_Obj_length( U ); - m_V = FLA_Obj_length( V ); - n_GH = FLA_Obj_width( G ); + m_U = FLA_Obj_length(U); + m_V = FLA_Obj_length(V); + n_GH = FLA_Obj_width(G); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); + inc_d = FLA_Obj_vector_inc(d); + inc_e = FLA_Obj_vector_inc(e); - rs_G = FLA_Obj_row_stride( G ); - cs_G = FLA_Obj_col_stride( G ); + rs_G = FLA_Obj_row_stride(G); + cs_G = FLA_Obj_col_stride(G); - rs_H = FLA_Obj_row_stride( H ); - cs_H = FLA_Obj_col_stride( H ); + rs_H = FLA_Obj_row_stride(H); + cs_H = FLA_Obj_col_stride(H); - rs_U = FLA_Obj_row_stride( U ); - cs_U = FLA_Obj_col_stride( U ); + rs_U = FLA_Obj_row_stride(U); + cs_U = FLA_Obj_col_stride(U); - rs_V = FLA_Obj_row_stride( V ); - cs_V = FLA_Obj_col_stride( V ); + rs_V = FLA_Obj_row_stride(V); + cs_V = FLA_Obj_col_stride(V); - - switch ( datatype ) + switch (datatype) { case FLA_FLOAT: { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - scomplex* buff_H = FLA_COMPLEX_PTR( H ); - float* buff_U = FLA_FLOAT_PTR( U ); - float* buff_V = FLA_FLOAT_PTR( V ); - - r_val = FLA_Bsvd_v_ops_var1( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + scomplex *buff_H = FLA_COMPLEX_PTR(H); + float *buff_U = FLA_FLOAT_PTR(U); + float *buff_V = FLA_FLOAT_PTR(V); + + r_val = FLA_Bsvd_v_ops_var1(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); break; } case FLA_DOUBLE: { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - dcomplex* buff_H = FLA_DOUBLE_COMPLEX_PTR( H ); - double* buff_U = FLA_DOUBLE_PTR( U ); - double* buff_V = FLA_DOUBLE_PTR( V ); - - r_val = FLA_Bsvd_v_opd_var1( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + dcomplex *buff_H = FLA_DOUBLE_COMPLEX_PTR(H); + double *buff_U = FLA_DOUBLE_PTR(U); + double *buff_V = FLA_DOUBLE_PTR(V); + + r_val = FLA_Bsvd_v_opd_var1(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); break; } case FLA_COMPLEX: { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - scomplex* buff_H = FLA_COMPLEX_PTR( H ); - scomplex* buff_U = FLA_COMPLEX_PTR( U ); - scomplex* buff_V = FLA_COMPLEX_PTR( V ); - - r_val = FLA_Bsvd_v_opc_var1( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + scomplex *buff_H = FLA_COMPLEX_PTR(H); + scomplex *buff_U = FLA_COMPLEX_PTR(U); + scomplex *buff_V = FLA_COMPLEX_PTR(V); + + r_val = FLA_Bsvd_v_opc_var1(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); break; } case FLA_DOUBLE_COMPLEX: { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - dcomplex* buff_H = FLA_DOUBLE_COMPLEX_PTR( H ); - dcomplex* buff_U = FLA_DOUBLE_COMPLEX_PTR( U ); - dcomplex* buff_V = FLA_DOUBLE_COMPLEX_PTR( V ); - - r_val = FLA_Bsvd_v_opz_var1( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + dcomplex *buff_H = FLA_DOUBLE_COMPLEX_PTR(H); + dcomplex *buff_U = FLA_DOUBLE_COMPLEX_PTR(U); + dcomplex *buff_V = FLA_DOUBLE_COMPLEX_PTR(V); + + r_val = FLA_Bsvd_v_opz_var1(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); break; } @@ -152,58 +151,54 @@ FLA_Error FLA_Bsvd_v_opt_var1( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G return r_val; } - - -FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - scomplex* buff_H, integer rs_H, integer cs_H, - float* buff_U, integer rs_U, integer cs_U, - float* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_ops_var1(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + scomplex *buff_H, integer rs_H, integer cs_H, + float *buff_U, integer rs_U, integer cs_U, + float *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - scomplex one = bl1_c1(); - float rzero = bl1_s0(); - - integer maxitr = 6; - - float eps; - float tolmul; - float tol; - float thresh; - - scomplex* G; - scomplex* H; - float* d1; - float* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + scomplex one = bl1_c1(); + float rzero = bl1_s0(); + + integer maxitr = 6; + + float eps; + float tolmul; + float tol; + float thresh; + + scomplex *G; + scomplex *H; + float *d1; + float *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; // Compute some convergence constants. - eps = FLA_Mach_params_ops( FLA_MACH_EPS ); - tolmul = fla_max( 10.0F, fla_min( 100.0F, powf( eps, -0.125F ) ) ); - FLA_Bsvd_compute_tol_thresh_ops( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_ops(FLA_MACH_EPS); + tolmul = fla_max(10.0F, fla_min(100.0F, powf(eps, -0.125F))); + FLA_Bsvd_compute_tol_thresh_ops(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); // Initialize our completion flag. done = FALSE; @@ -216,18 +211,18 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_csetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_csetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_csetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_csetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -237,7 +232,7 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { // Search for the first submatrix along the diagonal that is @@ -247,12 +242,12 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_ops( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_ops(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -260,9 +255,9 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { done = TRUE; } @@ -290,8 +285,8 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever a split occurs. Iteration continues as @@ -301,23 +296,20 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_ops_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); - - // Record the number of deflations that were observed. - total_deflations += n_deflations; + FLA_Bsvd_iteracc_v_ops_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); // Store the most recent value of ijBR in m_G_sweep_max. // When the sweep is done, this value will contain the minimum @@ -327,10 +319,10 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, m_GH_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= n_iter_max * min_m_n ) + if (n_iter_prev >= n_iter_max * min_m_n) { FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -345,46 +337,45 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_bls_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bls_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, - m_U, - n_UV_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - //FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bls_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, - m_V, - n_UV_apply, - buff_H, rs_H, cs_H, - buff_V, rs_V, cs_V, - b_alg ); + // FLA_Apply_G_rf_bls_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bls_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, + m_U, + n_UV_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + // FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bls_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, + m_V, + n_UV_apply, + buff_H, rs_H, cs_H, + buff_V, rs_V, cs_V, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; - } // Make all the singular values positive. { - integer i; - float minus_one = bl1_sm1(); + integer i; + float minus_one = bl1_sm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; // Scale the right singular vectors. - bl1_sscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_sscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } @@ -392,62 +383,61 @@ FLA_Error FLA_Bsvd_v_ops_var1( integer min_m_n, return n_iter_prev; } - - -FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - dcomplex* buff_H, integer rs_H, integer cs_H, - double* buff_U, integer rs_U, integer cs_U, - double* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_opd_var1(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + dcomplex *buff_H, integer rs_H, integer cs_H, + double *buff_U, integer rs_U, integer cs_U, + double *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - dcomplex one = bl1_z1(); - double rzero = bl1_d0(); - - integer maxitr = 6; - - double eps; - double tolmul; - double tol; - double thresh; - - dcomplex* G; - dcomplex* H; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rzero = bl1_d0(); + + integer maxitr = 6; + + double eps; + double tolmul; + double tol; + double thresh; + + dcomplex *G; + dcomplex *H; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; // Compute some convergence constants. - eps = FLA_Mach_params_opd( FLA_MACH_EPS ); - tolmul = fla_max( 10.0, fla_min( 100.0, pow( eps, -0.125 ) ) ); - FLA_Bsvd_compute_tol_thresh_opd( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_opd(FLA_MACH_EPS); + tolmul = fla_max(10.0, fla_min(100.0, pow(eps, -0.125))); + FLA_Bsvd_compute_tol_thresh_opd(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: tolmul = %12.6e\n", tolmul ); - printf( "FLA_Bsvd_v_opd_var1: tol = %12.6e\n", tol ); - printf( "FLA_Bsvd_v_opd_var1: thresh = %12.6e\n", thresh ); + integer n_deflations; + integer total_deflations; + total_deflations = 0; + printf("FLA_Bsvd_v_opd_var1: tolmul = %12.6e\n", tolmul); + printf("FLA_Bsvd_v_opd_var1: tol = %12.6e\n", tol); + printf("FLA_Bsvd_v_opd_var1: thresh = %12.6e\n", thresh); #endif // Initialize our completion flag. @@ -461,18 +451,18 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -482,12 +472,12 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { #ifdef PRINTF - if ( ij_begin == 0 ) - printf( "FLA_Bsvd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Bsvd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -497,12 +487,12 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_opd( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_opd(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -510,13 +500,13 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: superdiagonal is completely zero.\n" ); - printf( "FLA_Bsvd_v_opd_var1: Francis iteration is done!\n" ); + printf("FLA_Bsvd_v_opd_var1: superdiagonal is completely zero.\n"); + printf("FLA_Bsvd_v_opd_var1: Francis iteration is done!\n"); #endif done = TRUE; } @@ -538,10 +528,10 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, m_A11 = ijBR - ijTL + 1; #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: ij_begin = %d\n", ij_begin ); - printf( "FLA_Bsvd_v_opd_var1: ijTL = %d\n", ijTL ); - printf( "FLA_Bsvd_v_opd_var1: ijBR = %d\n", ijBR ); - printf( "FLA_Bsvd_v_opd_var1: m_A11 = %d\n", m_A11 ); + printf("FLA_Bsvd_v_opd_var1: ij_begin = %d\n", ij_begin); + printf("FLA_Bsvd_v_opd_var1: ijTL = %d\n", ijTL); + printf("FLA_Bsvd_v_opd_var1: ijBR = %d\n", ijBR); + printf("FLA_Bsvd_v_opd_var1: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -551,8 +541,8 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever a split occurs. Iteration continues as @@ -562,28 +552,40 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Record the number of deflations that were observed. total_deflations += n_deflations; +#else + FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: deflations observed = %d\n", n_deflations ); - printf( "FLA_Bsvd_v_opd_var1: total deflations observed = %d\n", total_deflations ); - printf( "FLA_Bsvd_v_opd_var1: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Bsvd_v_opd_var1: deflations observed = %d\n", n_deflations); + printf("FLA_Bsvd_v_opd_var1: total deflations observed = %d\n", total_deflations); + printf("FLA_Bsvd_v_opd_var1: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -594,13 +596,13 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, m_GH_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= n_iter_max * min_m_n ) + if (n_iter_prev >= n_iter_max * min_m_n) { #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opd_var1: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -612,58 +614,58 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, n_UV_apply = m_GH_sweep_max + 1; #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); - printf( "FLA_Bsvd_v_opd_var1: m_U = %d\n", m_U ); - printf( "FLA_Bsvd_v_opd_var1: m_V = %d\n", m_V ); - printf( "FLA_Bsvd_v_opd_var1: napp= %d\n", n_UV_apply ); + printf("FLA_Bsvd_v_opd_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); + printf("FLA_Bsvd_v_opd_var1: m_U = %d\n", m_U); + printf("FLA_Bsvd_v_opd_var1: m_V = %d\n", m_V); + printf("FLA_Bsvd_v_opd_var1: napp= %d\n", n_UV_apply); #endif // Apply the Givens rotations. Note that we only apply k sets of // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_bld_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, - m_U, - n_UV_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - //FLA_Apply_G_rf_bld_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, - m_V, - n_UV_apply, - buff_H, rs_H, cs_H, - buff_V, rs_V, cs_V, - b_alg ); + // FLA_Apply_G_rf_bld_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, + m_U, + n_UV_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + // FLA_Apply_G_rf_bld_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, + m_V, + n_UV_apply, + buff_H, rs_H, cs_H, + buff_V, rs_V, cs_V, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF - printf( "FLA_Bsvd_v_opd_var1: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opd_var1: total number of iterations performed: %d\n", n_iter_prev); #endif } // Make all the singular values positive. { - integer i; + integer i; double minus_one = bl1_dm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; // Scale the right singular vectors. - bl1_dscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_dscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } @@ -671,56 +673,54 @@ FLA_Error FLA_Bsvd_v_opd_var1( integer min_m_n, return n_iter_prev; } -FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - scomplex* buff_H, integer rs_H, integer cs_H, - scomplex* buff_U, integer rs_U, integer cs_U, - scomplex* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_opc_var1(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + scomplex *buff_H, integer rs_H, integer cs_H, + scomplex *buff_U, integer rs_U, integer cs_U, + scomplex *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - scomplex one = bl1_c1(); - float rzero = bl1_s0(); - - integer maxitr = 6; - - float eps; - float tolmul; - float tol; - float thresh; - - scomplex* G; - scomplex* H; - float* d1; - float* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + scomplex one = bl1_c1(); + float rzero = bl1_s0(); + + integer maxitr = 6; + + float eps; + float tolmul; + float tol; + float thresh; + + scomplex *G; + scomplex *H; + float *d1; + float *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; // Compute some convergence constants. - eps = FLA_Mach_params_ops( FLA_MACH_EPS ); - tolmul = fla_max( 10.0F, fla_min( 100.0F, powf( eps, -0.125F ) ) ); - FLA_Bsvd_compute_tol_thresh_ops( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_ops(FLA_MACH_EPS); + tolmul = fla_max(10.0F, fla_min(100.0F, powf(eps, -0.125F))); + FLA_Bsvd_compute_tol_thresh_ops(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); // Initialize our completion flag. done = FALSE; @@ -733,18 +733,18 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_csetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_csetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_csetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_csetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -754,7 +754,7 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { // Search for the first submatrix along the diagonal that is // bounded by zeroes (or endpoints of the matrix). If no @@ -763,12 +763,12 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_ops( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_ops(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -776,9 +776,9 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { done = TRUE; } @@ -806,8 +806,8 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever a split occurs. Iteration continues as @@ -817,23 +817,20 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_ops_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); - - // Record the number of deflations that were observed. - total_deflations += n_deflations; + FLA_Bsvd_iteracc_v_ops_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); // Store the most recent value of ijBR in m_G_sweep_max. // When the sweep is done, this value will contain the minimum @@ -843,10 +840,10 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, m_GH_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= n_iter_max * min_m_n ) + if (n_iter_prev >= n_iter_max * min_m_n) { FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -861,24 +858,24 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_blc_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, - m_U, - n_UV_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - //FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_blc_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, - m_V, - n_UV_apply, - buff_H, rs_H, cs_H, - buff_V, rs_V, cs_V, - b_alg ); + // FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_blc_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, + m_U, + n_UV_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + // FLA_Apply_G_rf_blc_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_blc_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, + m_V, + n_UV_apply, + buff_H, rs_H, cs_H, + buff_V, rs_V, cs_V, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; @@ -886,20 +883,20 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, // Make all the singular values positive. { - integer i; - float minus_one = bl1_sm1(); + integer i; + float minus_one = bl1_sm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; // Scale the right singular vectors. - bl1_csscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_csscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } @@ -907,62 +904,63 @@ FLA_Error FLA_Bsvd_v_opc_var1( integer min_m_n, return FLA_SUCCESS; } -//#define PRINTF - -FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - dcomplex* buff_H, integer rs_H, integer cs_H, - dcomplex* buff_U, integer rs_U, integer cs_U, - dcomplex* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +// #define PRINTF + +FLA_Error FLA_Bsvd_v_opz_var1(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + dcomplex *buff_H, integer rs_H, integer cs_H, + dcomplex *buff_U, integer rs_U, integer cs_U, + dcomplex *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - dcomplex one = bl1_z1(); - double rzero = bl1_d0(); - - integer maxitr = 6; - - double eps; - double tolmul; - double tol; - double thresh; - - dcomplex* G; - dcomplex* H; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rzero = bl1_d0(); + + integer maxitr = 6; + + double eps; + double tolmul; + double tol; + double thresh; + + dcomplex *G; + dcomplex *H; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; // Compute some convergence constants. - eps = FLA_Mach_params_opd( FLA_MACH_EPS ); - tolmul = fla_max( 10.0, fla_min( 100.0, pow( eps, -0.125 ) ) ); - FLA_Bsvd_compute_tol_thresh_opd( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_opd(FLA_MACH_EPS); + tolmul = fla_max(10.0, fla_min(100.0, pow(eps, -0.125))); + FLA_Bsvd_compute_tol_thresh_opd(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: tolmul = %12.6e\n", tolmul ); - printf( "FLA_Bsvd_v_opz_var1: tol = %12.6e\n", tol ); - printf( "FLA_Bsvd_v_opz_var1: thresh = %12.6e\n", thresh ); + integer n_deflations; + integer total_deflations; + total_deflations = 0; + printf("FLA_Bsvd_v_opz_var1: tolmul = %12.6e\n", tolmul); + printf("FLA_Bsvd_v_opz_var1: tol = %12.6e\n", tol); + printf("FLA_Bsvd_v_opz_var1: thresh = %12.6e\n", thresh); #endif // Initialize our completion flag. @@ -976,18 +974,18 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -997,12 +995,12 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { #ifdef PRINTF - if ( ij_begin == 0 ) - printf( "FLA_Bsvd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Bsvd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -1012,12 +1010,12 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_opd( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_opd(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -1025,13 +1023,13 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: superdiagonal is completely zero.\n" ); - printf( "FLA_Bsvd_v_opz_var1: Francis iteration is done!\n" ); + printf("FLA_Bsvd_v_opz_var1: superdiagonal is completely zero.\n"); + printf("FLA_Bsvd_v_opz_var1: Francis iteration is done!\n"); #endif done = TRUE; } @@ -1053,10 +1051,10 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, m_A11 = ijBR - ijTL + 1; #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: ij_begin = %d\n", ij_begin ); - printf( "FLA_Bsvd_v_opz_var1: ijTL = %d\n", ijTL ); - printf( "FLA_Bsvd_v_opz_var1: ijBR = %d\n", ijBR ); - printf( "FLA_Bsvd_v_opz_var1: m_A11 = %d\n", m_A11 ); + printf("FLA_Bsvd_v_opz_var1: ij_begin = %d\n", ij_begin); + printf("FLA_Bsvd_v_opz_var1: ijTL = %d\n", ijTL); + printf("FLA_Bsvd_v_opz_var1: ijBR = %d\n", ijBR); + printf("FLA_Bsvd_v_opz_var1: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -1066,8 +1064,8 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever a split occurs. Iteration continues as @@ -1077,28 +1075,39 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Record the number of deflations that were observed. total_deflations += n_deflations; - +#else + FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: deflations observed = %d\n", n_deflations ); - printf( "FLA_Bsvd_v_opz_var1: total deflations observed = %d\n", total_deflations ); - printf( "FLA_Bsvd_v_opz_var1: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Bsvd_v_opz_var1: deflations observed = %d\n", n_deflations); + printf("FLA_Bsvd_v_opz_var1: total deflations observed = %d\n", total_deflations); + printf("FLA_Bsvd_v_opz_var1: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -1109,13 +1118,13 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, m_GH_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= n_iter_max * min_m_n ) + if (n_iter_prev >= n_iter_max * min_m_n) { #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -1127,62 +1136,61 @@ FLA_Error FLA_Bsvd_v_opz_var1( integer min_m_n, n_UV_apply = m_GH_sweep_max + 1; #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); - printf( "FLA_Bsvd_v_opz_var1: m_U = %d\n", m_U ); - printf( "FLA_Bsvd_v_opz_var1: m_V = %d\n", m_V ); - printf( "FLA_Bsvd_v_opz_var1: napp= %d\n", n_UV_apply ); + printf("FLA_Bsvd_v_opz_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); + printf("FLA_Bsvd_v_opz_var1: m_U = %d\n", m_U); + printf("FLA_Bsvd_v_opz_var1: m_V = %d\n", m_V); + printf("FLA_Bsvd_v_opz_var1: napp= %d\n", n_UV_apply); #endif // Apply the Givens rotations. Note that we only apply k sets of // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_blz_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, - m_U, - n_UV_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - //FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_blz_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, - m_V, - n_UV_apply, - buff_H, rs_H, cs_H, - buff_V, rs_V, cs_V, - b_alg ); + // FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_blz_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, + m_U, + n_UV_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + // FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_blz_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, + m_V, + n_UV_apply, + buff_H, rs_H, cs_H, + buff_V, rs_V, cs_V, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF - printf( "FLA_Bsvd_v_opz_var1: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opz_var1: total number of iterations performed: %d\n", n_iter_prev); #endif } // Make all the singular values positive. { - integer i; + integer i; double minus_one = bl1_dm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; // Scale the right singular vectors. - bl1_zdscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_zdscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } return n_iter_prev; } - diff --git a/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var2.c b/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var2.c index e142b2863..4dc6b1f2c 100644 --- a/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var2.c +++ b/src/lapack/dec/bsvd/v/flamec/FLA_Bsvd_v_opt_var2.c @@ -1,270 +1,271 @@ /* - Copyright (C) 2014, The University of Texas at Austin + Copyright (C) 2014, The University of Texas at Austin - This file is part of libflame and is available under the 3-Clause - BSD license, which can be found in the LICENSE file at the top-level - directory, or at http://opensource.org/licenses/BSD-3-Clause + This file is part of libflame and is available under the 3-Clause + BSD license, which can be found in the LICENSE file at the top-level + directory, or at http://opensource.org/licenses/BSD-3-Clause */ #include "FLAME.h" -FLA_Error FLA_Bsvd_v_opt_var2( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj H, FLA_Obj RG, FLA_Obj RH, FLA_Obj W, FLA_Obj U, FLA_Obj V, dim_t b_alg ) +FLA_Error FLA_Bsvd_v_opt_var2(dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj H, FLA_Obj RG, FLA_Obj RH, FLA_Obj W, FLA_Obj U, FLA_Obj V, dim_t b_alg) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype datatype; - integer m_U, m_V, n_GH; - integer inc_d; - integer inc_e; - integer rs_G, cs_G; - integer rs_H, cs_H; - integer rs_RG, cs_RG; - integer rs_RH, cs_RH; - integer rs_W, cs_W; - integer rs_U, cs_U; - integer rs_V, cs_V; + integer m_U, m_V, n_GH; + integer inc_d; + integer inc_e; + integer rs_G, cs_G; + integer rs_H, cs_H; + integer rs_RG, cs_RG; + integer rs_RH, cs_RH; + integer rs_W, cs_W; + integer rs_U, cs_U; + integer rs_V, cs_V; - datatype = FLA_Obj_datatype( U ); + datatype = FLA_Obj_datatype(U); - m_U = FLA_Obj_length( U ); - m_V = FLA_Obj_length( V ); - n_GH = FLA_Obj_width( G ); + m_U = FLA_Obj_length(U); + m_V = FLA_Obj_length(V); + n_GH = FLA_Obj_width(G); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - - rs_G = FLA_Obj_row_stride( G ); - cs_G = FLA_Obj_col_stride( G ); + inc_d = FLA_Obj_vector_inc(d); + inc_e = FLA_Obj_vector_inc(e); - rs_H = FLA_Obj_row_stride( H ); - cs_H = FLA_Obj_col_stride( H ); + rs_G = FLA_Obj_row_stride(G); + cs_G = FLA_Obj_col_stride(G); - rs_RG = FLA_Obj_row_stride( RG ); - cs_RG = FLA_Obj_col_stride( RG ); + rs_H = FLA_Obj_row_stride(H); + cs_H = FLA_Obj_col_stride(H); - rs_RH = FLA_Obj_row_stride( RH ); - cs_RH = FLA_Obj_col_stride( RH ); + rs_RG = FLA_Obj_row_stride(RG); + cs_RG = FLA_Obj_col_stride(RG); - rs_W = FLA_Obj_row_stride( W ); - cs_W = FLA_Obj_col_stride( W ); + rs_RH = FLA_Obj_row_stride(RH); + cs_RH = FLA_Obj_col_stride(RH); - rs_U = FLA_Obj_row_stride( U ); - cs_U = FLA_Obj_col_stride( U ); + rs_W = FLA_Obj_row_stride(W); + cs_W = FLA_Obj_col_stride(W); - rs_V = FLA_Obj_row_stride( V ); - cs_V = FLA_Obj_col_stride( V ); + rs_U = FLA_Obj_row_stride(U); + cs_U = FLA_Obj_col_stride(U); + rs_V = FLA_Obj_row_stride(V); + cs_V = FLA_Obj_col_stride(V); - switch ( datatype ) + switch (datatype) { - case FLA_FLOAT: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - scomplex* buff_H = FLA_COMPLEX_PTR( H ); - float* buff_RG = FLA_FLOAT_PTR( RG ); - float* buff_RH = FLA_FLOAT_PTR( RH ); - float* buff_W = FLA_FLOAT_PTR( W ); - float* buff_U = FLA_FLOAT_PTR( U ); - float* buff_V = FLA_FLOAT_PTR( V ); - - r_val = FLA_Bsvd_v_ops_var2( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_RG, rs_RG, cs_RG, - buff_RH, rs_RH, cs_RH, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); - - break; - } + case FLA_FLOAT: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + scomplex *buff_H = FLA_COMPLEX_PTR(H); + float *buff_RG = FLA_FLOAT_PTR(RG); + float *buff_RH = FLA_FLOAT_PTR(RH); + float *buff_W = FLA_FLOAT_PTR(W); + float *buff_U = FLA_FLOAT_PTR(U); + float *buff_V = FLA_FLOAT_PTR(V); + + r_val = FLA_Bsvd_v_ops_var2(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_RG, rs_RG, cs_RG, + buff_RH, rs_RH, cs_RH, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); + + break; + } - case FLA_DOUBLE: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - dcomplex* buff_H = FLA_DOUBLE_COMPLEX_PTR( H ); - double* buff_RG = FLA_DOUBLE_PTR( RG ); - double* buff_RH = FLA_DOUBLE_PTR( RH ); - double* buff_W = FLA_DOUBLE_PTR( W ); - double* buff_U = FLA_DOUBLE_PTR( U ); - double* buff_V = FLA_DOUBLE_PTR( V ); - - r_val = FLA_Bsvd_v_opd_var2( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_RG, rs_RG, cs_RG, - buff_RH, rs_RH, cs_RH, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); - - break; - } + case FLA_DOUBLE: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + dcomplex *buff_H = FLA_DOUBLE_COMPLEX_PTR(H); + double *buff_RG = FLA_DOUBLE_PTR(RG); + double *buff_RH = FLA_DOUBLE_PTR(RH); + double *buff_W = FLA_DOUBLE_PTR(W); + double *buff_U = FLA_DOUBLE_PTR(U); + double *buff_V = FLA_DOUBLE_PTR(V); + + r_val = FLA_Bsvd_v_opd_var2(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_RG, rs_RG, cs_RG, + buff_RH, rs_RH, cs_RH, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); + + break; + } - case FLA_COMPLEX: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - scomplex* buff_H = FLA_COMPLEX_PTR( H ); - float* buff_RG = FLA_FLOAT_PTR( RG ); - float* buff_RH = FLA_FLOAT_PTR( RH ); - scomplex* buff_W = FLA_COMPLEX_PTR( W ); - scomplex* buff_U = FLA_COMPLEX_PTR( U ); - scomplex* buff_V = FLA_COMPLEX_PTR( V ); - - r_val = FLA_Bsvd_v_opc_var2( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_RG, rs_RG, cs_RG, - buff_RH, rs_RH, cs_RH, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); - - break; - } + case FLA_COMPLEX: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + scomplex *buff_H = FLA_COMPLEX_PTR(H); + float *buff_RG = FLA_FLOAT_PTR(RG); + float *buff_RH = FLA_FLOAT_PTR(RH); + scomplex *buff_W = FLA_COMPLEX_PTR(W); + scomplex *buff_U = FLA_COMPLEX_PTR(U); + scomplex *buff_V = FLA_COMPLEX_PTR(V); + + r_val = FLA_Bsvd_v_opc_var2(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_RG, rs_RG, cs_RG, + buff_RH, rs_RH, cs_RH, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); + + break; + } - case FLA_DOUBLE_COMPLEX: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - dcomplex* buff_H = FLA_DOUBLE_COMPLEX_PTR( H ); - double* buff_RG = FLA_DOUBLE_PTR( RG ); - double* buff_RH = FLA_DOUBLE_PTR( RH ); - dcomplex* buff_W = FLA_DOUBLE_COMPLEX_PTR( W ); - dcomplex* buff_U = FLA_DOUBLE_COMPLEX_PTR( U ); - dcomplex* buff_V = FLA_DOUBLE_COMPLEX_PTR( V ); - - r_val = FLA_Bsvd_v_opz_var2( fla_min( m_U, m_V ), - m_U, - m_V, - n_GH, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_H, rs_H, cs_H, - buff_RG, rs_RG, cs_RG, - buff_RH, rs_RH, cs_RH, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - buff_V, rs_V, cs_V, - b_alg ); - - break; - } + case FLA_DOUBLE_COMPLEX: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + dcomplex *buff_H = FLA_DOUBLE_COMPLEX_PTR(H); + double *buff_RG = FLA_DOUBLE_PTR(RG); + double *buff_RH = FLA_DOUBLE_PTR(RH); + dcomplex *buff_W = FLA_DOUBLE_COMPLEX_PTR(W); + dcomplex *buff_U = FLA_DOUBLE_COMPLEX_PTR(U); + dcomplex *buff_V = FLA_DOUBLE_COMPLEX_PTR(V); + + r_val = FLA_Bsvd_v_opz_var2(fla_min(m_U, m_V), + m_U, + m_V, + n_GH, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_H, rs_H, cs_H, + buff_RG, rs_RG, cs_RG, + buff_RH, rs_RH, cs_RH, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + buff_V, rs_V, cs_V, + b_alg); + + break; + } } return r_val; } - - -FLA_Error FLA_Bsvd_v_ops_var2( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - scomplex* buff_H, integer rs_H, integer cs_H, - float* buff_RG, integer rs_RG, integer cs_RG, - float* buff_RH, integer rs_RH, integer cs_RH, - float* buff_W, integer rs_W, integer cs_W, - float* buff_U, integer rs_U, integer cs_U, - float* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_ops_var2(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + scomplex *buff_H, integer rs_H, integer cs_H, + float *buff_RG, integer rs_RG, integer cs_RG, + float *buff_RH, integer rs_RH, integer cs_RH, + float *buff_W, integer rs_W, integer cs_W, + float *buff_U, integer rs_U, integer cs_U, + float *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } -//#define PRINTF - -FLA_Error FLA_Bsvd_v_opd_var2( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - dcomplex* buff_H, integer rs_H, integer cs_H, - double* buff_RG, integer rs_RG, integer cs_RG, - double* buff_RH, integer rs_RH, integer cs_RH, - double* buff_W, integer rs_W, integer cs_W, - double* buff_U, integer rs_U, integer cs_U, - double* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +// #define PRINTF + +FLA_Error FLA_Bsvd_v_opd_var2(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + dcomplex *buff_H, integer rs_H, integer cs_H, + double *buff_RG, integer rs_RG, integer cs_RG, + double *buff_RH, integer rs_RH, integer cs_RH, + double *buff_W, integer rs_W, integer cs_W, + double *buff_U, integer rs_U, integer cs_U, + double *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - dcomplex one = bl1_z1(); - double rone = bl1_d1(); - double rzero = bl1_d0(); - - integer maxitr = 6; - - double eps; - double tolmul; - double tol; - double thresh; - - dcomplex* G; - dcomplex* H; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rone = bl1_d1(); + double rzero = bl1_d0(); + + integer maxitr = 6; + + double eps; + double tolmul; + double tol; + double thresh; + + dcomplex *G; + dcomplex *H; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; + +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0; +#endif // Compute some convergence constants. - eps = FLA_Mach_params_opd( FLA_MACH_EPS ); - tolmul = fla_max( 10.0, fla_min( 100.0, pow( eps, -0.125 ) ) ); - FLA_Bsvd_compute_tol_thresh_opd( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_opd(FLA_MACH_EPS); + tolmul = fla_max(10.0, fla_min(100.0, pow(eps, -0.125))); + FLA_Bsvd_compute_tol_thresh_opd(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); // Initialize our completion flag. done = FALSE; @@ -277,24 +278,24 @@ FLA_Error FLA_Bsvd_v_opd_var2( integer min_m_n, n_iter_prev = 0; // Initialize RG and RH to identity. - bl1_dident( min_m_n, - buff_RG, rs_RG, cs_RG ); - bl1_dident( min_m_n, - buff_RH, rs_RH, cs_RH ); + bl1_dident(min_m_n, + buff_RG, rs_RG, cs_RG); + bl1_dident(min_m_n, + buff_RH, rs_RH, cs_RH); // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -304,12 +305,12 @@ FLA_Error FLA_Bsvd_v_opd_var2( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Bsvd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Bsvd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -319,12 +320,12 @@ printf( "FLA_Bsvd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_opd( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_opd(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -332,13 +333,13 @@ printf( "FLA_Bsvd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Bsvd_v_opd_var2: superdiagonal is completely zero.\n" ); -printf( "FLA_Bsvd_v_opd_var2: Francis iteration is done!\n" ); + printf("FLA_Bsvd_v_opd_var2: superdiagonal is completely zero.\n"); + printf("FLA_Bsvd_v_opd_var2: Francis iteration is done!\n"); #endif done = TRUE; } @@ -360,10 +361,10 @@ printf( "FLA_Bsvd_v_opd_var2: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Bsvd_v_opd_var2: ij_begin = %d\n", ij_begin ); -printf( "FLA_Bsvd_v_opd_var2: ijTL = %d\n", ijTL ); -printf( "FLA_Bsvd_v_opd_var2: ijBR = %d\n", ijBR ); -printf( "FLA_Bsvd_v_opd_var2: m_A11 = %d\n", m_A11 ); + printf("FLA_Bsvd_v_opd_var2: ij_begin = %d\n", ij_begin); + printf("FLA_Bsvd_v_opd_var2: ijTL = %d\n", ijTL); + printf("FLA_Bsvd_v_opd_var2: ijBR = %d\n", ijBR); + printf("FLA_Bsvd_v_opd_var2: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -373,8 +374,8 @@ printf( "FLA_Bsvd_v_opd_var2: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever possible. A new singular value search is @@ -384,28 +385,41 @@ printf( "FLA_Bsvd_v_opd_var2: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); +#ifdef PRINTF + n_deflations = FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Record the number of deflations that occurred. total_deflations += n_deflations; +#else + FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Bsvd_v_opd_var2: deflations observed = %d\n", n_deflations ); -printf( "FLA_Bsvd_v_opd_var2: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Bsvd_v_opd_var2: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Bsvd_v_opd_var2: deflations observed = %d\n", n_deflations); + printf("FLA_Bsvd_v_opd_var2: total deflations observed = %d\n", total_deflations); + printf("FLA_Bsvd_v_opd_var2: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -414,7 +428,6 @@ printf( "FLA_Bsvd_v_opd_var2: num iterations performed = %d\n", n_iter_perf ); // non-identity rotations that were computed during the // singular value searches. m_GH_sweep_max = ijBR; - } // The sweep is complete. Now we must apply the Givens rotations @@ -424,101 +437,100 @@ printf( "FLA_Bsvd_v_opd_var2: num iterations performed = %d\n", n_iter_perf ); // rotations is one more than the number of rotations. n_UV_apply = m_GH_sweep_max + 1; - #ifdef PRINTF -printf( "FLA_Bsvd_v_opd_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); -printf( "FLA_Bsvd_v_opd_var2: m_U = %d\n", m_U ); -printf( "FLA_Bsvd_v_opd_var2: m_V = %d\n", m_V ); -printf( "FLA_Bsvd_v_opd_var2: napp= %d\n", n_UV_apply ); + printf("FLA_Bsvd_v_opd_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); + printf("FLA_Bsvd_v_opd_var2: m_U = %d\n", m_U); + printf("FLA_Bsvd_v_opd_var2: m_V = %d\n", m_V); + printf("FLA_Bsvd_v_opd_var2: napp= %d\n", n_UV_apply); #endif // Apply the Givens rotations. Note that we only apply k sets of // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - min_m_n, - n_UV_apply, - n_iter_prev, - buff_G, rs_G, cs_G, - buff_RG, rs_RG, cs_RG, - b_alg ); - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - min_m_n, - n_UV_apply, - n_iter_prev, - buff_H, rs_H, cs_H, - buff_RH, rs_RH, cs_RH, - b_alg ); + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + min_m_n, + n_UV_apply, + n_iter_prev, + buff_G, rs_G, cs_G, + buff_RG, rs_RG, cs_RG, + b_alg); + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + min_m_n, + n_UV_apply, + n_iter_prev, + buff_H, rs_H, cs_H, + buff_RH, rs_RH, cs_RH, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF -printf( "FLA_Bsvd_v_opd_var2: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opd_var2: total number of iterations performed: %d\n", n_iter_prev); #endif } // Copy the contents of Q to temporary storage. - bl1_dcopymt( BLIS1_NO_TRANSPOSE, - m_U, - m_V, - buff_U, rs_U, cs_U, - buff_W, rs_W, cs_W ); -// W needs to be max_m_n-by-min_m_n!!!!!!!!!!!!!!! + bl1_dcopymt(BLIS1_NO_TRANSPOSE, + m_U, + m_V, + buff_U, rs_U, cs_U, + buff_W, rs_W, cs_W); + // W needs to be max_m_n-by-min_m_n!!!!!!!!!!!!!!! // Multiply U by R, overwriting U. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - m_U, - m_V, - m_V, - &rone, - ( double* )buff_W, rs_W, cs_W, - buff_RG, rs_RG, cs_RG, - &rzero, - ( double* )buff_U, rs_U, cs_U ); - - bl1_dcopymt( BLIS1_NO_TRANSPOSE, - m_V, - m_V, - buff_V, rs_V, cs_V, - buff_W, rs_W, cs_W ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + m_U, + m_V, + m_V, + &rone, + (double *)buff_W, rs_W, cs_W, + buff_RG, rs_RG, cs_RG, + &rzero, + (double *)buff_U, rs_U, cs_U); + + bl1_dcopymt(BLIS1_NO_TRANSPOSE, + m_V, + m_V, + buff_V, rs_V, cs_V, + buff_W, rs_W, cs_W); // Multiply V by R, overwriting V. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - m_V, - m_V, - m_V, - &rone, - ( double* )buff_W, rs_W, cs_W, - buff_RH, rs_RH, cs_RH, - &rzero, - ( double* )buff_V, rs_V, cs_V ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + m_V, + m_V, + m_V, + &rone, + (double *)buff_W, rs_W, cs_W, + buff_RH, rs_RH, cs_RH, + &rzero, + (double *)buff_V, rs_V, cs_V); // Make all the singular values positive. { - integer i; + integer i; double minus_one = bl1_dm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; - + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; + // Scale the right singular vectors. - bl1_dscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_dscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } @@ -526,81 +538,85 @@ printf( "FLA_Bsvd_v_opd_var2: total number of iterations performed: %d\n", n_ite return n_iter_prev; } -FLA_Error FLA_Bsvd_v_opc_var2( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - scomplex* buff_H, integer rs_H, integer cs_H, - float* buff_RG, integer rs_RG, integer cs_RG, - float* buff_RH, integer rs_RH, integer cs_RH, - scomplex* buff_W, integer rs_W, integer cs_W, - scomplex* buff_U, integer rs_U, integer cs_U, - scomplex* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_opc_var2(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + scomplex *buff_H, integer rs_H, integer cs_H, + float *buff_RG, integer rs_RG, integer cs_RG, + float *buff_RH, integer rs_RH, integer cs_RH, + scomplex *buff_W, integer rs_W, integer cs_W, + scomplex *buff_U, integer rs_U, integer cs_U, + scomplex *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } -FLA_Error FLA_Bsvd_v_opz_var2( integer min_m_n, - integer m_U, - integer m_V, - integer n_GH, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - dcomplex* buff_H, integer rs_H, integer cs_H, - double* buff_RG, integer rs_RG, integer cs_RG, - double* buff_RH, integer rs_RH, integer cs_RH, - dcomplex* buff_W, integer rs_W, integer cs_W, - dcomplex* buff_U, integer rs_U, integer cs_U, - dcomplex* buff_V, integer rs_V, integer cs_V, - integer b_alg ) +FLA_Error FLA_Bsvd_v_opz_var2(integer min_m_n, + integer m_U, + integer m_V, + integer n_GH, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + dcomplex *buff_H, integer rs_H, integer cs_H, + double *buff_RG, integer rs_RG, integer cs_RG, + double *buff_RH, integer rs_RH, integer cs_RH, + dcomplex *buff_W, integer rs_W, integer cs_W, + dcomplex *buff_U, integer rs_U, integer cs_U, + dcomplex *buff_V, integer rs_V, integer cs_V, + integer b_alg) { - dcomplex one = bl1_z1(); - double rone = bl1_d1(); - double rzero = bl1_d0(); - - integer maxitr = 6; - - double eps; - double tolmul; - double tol; - double thresh; - - dcomplex* G; - dcomplex* H; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_GH_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_UV_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rone = bl1_d1(); + double rzero = bl1_d0(); + + integer maxitr = 6; + + double eps; + double tolmul; + double tol; + double thresh; + + dcomplex *G; + dcomplex *H; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_GH_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_UV_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; + +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0; +#endif // Compute some convergence constants. - eps = FLA_Mach_params_opd( FLA_MACH_EPS ); - tolmul = fla_max( 10.0, fla_min( 100.0, pow( eps, -0.125 ) ) ); - FLA_Bsvd_compute_tol_thresh_opd( min_m_n, - tolmul, - maxitr, - buff_d, inc_d, - buff_e, inc_e, - &tol, - &thresh ); + eps = FLA_Mach_params_opd(FLA_MACH_EPS); + tolmul = fla_max(10.0, fla_min(100.0, pow(eps, -0.125))); + FLA_Bsvd_compute_tol_thresh_opd(min_m_n, + tolmul, + maxitr, + buff_d, inc_d, + buff_e, inc_e, + &tol, + &thresh); // Initialize our completion flag. done = FALSE; @@ -613,24 +629,24 @@ FLA_Error FLA_Bsvd_v_opz_var2( integer min_m_n, n_iter_prev = 0; // Initialize RG and RH to identity. - bl1_dident( min_m_n, - buff_RG, rs_RG, cs_RG ); - bl1_dident( min_m_n, - buff_RH, rs_RH, cs_RH ); + bl1_dident(min_m_n, + buff_RG, rs_RG, cs_RG); + bl1_dident(min_m_n, + buff_RH, rs_RH, cs_RH); // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G and H to contain only identity rotations. - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_G, rs_G, cs_G ); - bl1_zsetm( m_GH_sweep_max, - n_GH, - &one, - buff_H, rs_H, cs_H ); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_G, rs_G, cs_G); + bl1_zsetm(m_GH_sweep_max, + n_GH, + &one, + buff_H, rs_H, cs_H); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -640,12 +656,12 @@ FLA_Error FLA_Bsvd_v_opz_var2( integer min_m_n, // Perform a sweep: Move through the matrix and perform a bidiagonal // SVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be min_m_n - 1. - for ( ij_begin = 0; ij_begin < min_m_n; ) + for (ij_begin = 0; ij_begin < min_m_n;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Bsvd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Bsvd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -655,12 +671,12 @@ printf( "FLA_Bsvd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // superdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Bsvd_find_submatrix_opd( min_m_n, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Bsvd_find_submatrix_opd(min_m_n, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -668,13 +684,13 @@ printf( "FLA_Bsvd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Bsvd_v_opz_var2: superdiagonal is completely zero.\n" ); -printf( "FLA_Bsvd_v_opz_var2: Francis iteration is done!\n" ); + printf("FLA_Bsvd_v_opz_var2: superdiagonal is completely zero.\n"); + printf("FLA_Bsvd_v_opz_var2: Francis iteration is done!\n"); #endif done = TRUE; } @@ -696,10 +712,10 @@ printf( "FLA_Bsvd_v_opz_var2: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Bsvd_v_opz_var2: ij_begin = %d\n", ij_begin ); -printf( "FLA_Bsvd_v_opz_var2: ijTL = %d\n", ijTL ); -printf( "FLA_Bsvd_v_opz_var2: ijBR = %d\n", ijBR ); -printf( "FLA_Bsvd_v_opz_var2: m_A11 = %d\n", m_A11 ); + printf("FLA_Bsvd_v_opz_var2: ij_begin = %d\n", ij_begin); + printf("FLA_Bsvd_v_opz_var2: ijTL = %d\n", ijTL); + printf("FLA_Bsvd_v_opz_var2: ijBR = %d\n", ijBR); + printf("FLA_Bsvd_v_opz_var2: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -709,8 +725,8 @@ printf( "FLA_Bsvd_v_opz_var2: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; - H = buff_H + ijTL * rs_H; + G = buff_G + ijTL * rs_G; + H = buff_H + ijTL * rs_H; // Search for a batch of singular values, recursing on deflated // subproblems whenever possible. A new singular value search is @@ -720,28 +736,40 @@ printf( "FLA_Bsvd_v_opz_var2: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Bsvd_iteracc_v_opd_var1( m_A11, - n_GH, - ijTL, - tol, - thresh, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - H, rs_H, cs_H, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); // Record the number of deflations that occurred. total_deflations += n_deflations; +#else + FLA_Bsvd_iteracc_v_opd_var1(m_A11, + n_GH, + ijTL, + tol, + thresh, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + H, rs_H, cs_H, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Bsvd_v_opz_var2: deflations observed = %d\n", n_deflations ); -printf( "FLA_Bsvd_v_opz_var2: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Bsvd_v_opz_var2: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Bsvd_v_opz_var2: deflations observed = %d\n", n_deflations); + printf("FLA_Bsvd_v_opz_var2: total deflations observed = %d\n", total_deflations); + printf("FLA_Bsvd_v_opz_var2: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -750,7 +778,6 @@ printf( "FLA_Bsvd_v_opz_var2: num iterations performed = %d\n", n_iter_perf ); // non-identity rotations that were computed during the // singular value searches. m_GH_sweep_max = ijBR; - } // The sweep is complete. Now we must apply the Givens rotations @@ -760,105 +787,103 @@ printf( "FLA_Bsvd_v_opz_var2: num iterations performed = %d\n", n_iter_perf ); // rotations is one more than the number of rotations. n_UV_apply = m_GH_sweep_max + 1; - #ifdef PRINTF -printf( "FLA_Bsvd_v_opz_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); -printf( "FLA_Bsvd_v_opz_var2: m_U = %d\n", m_U ); -printf( "FLA_Bsvd_v_opz_var2: m_V = %d\n", m_V ); -printf( "FLA_Bsvd_v_opz_var2: napp= %d\n", n_UV_apply ); + printf("FLA_Bsvd_v_opz_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); + printf("FLA_Bsvd_v_opz_var2: m_U = %d\n", m_U); + printf("FLA_Bsvd_v_opz_var2: m_V = %d\n", m_V); + printf("FLA_Bsvd_v_opz_var2: napp= %d\n", n_UV_apply); #endif // Apply the Givens rotations. Note that we only apply k sets of // rotations, where k = n_iter_perf_sweep_max. Also note that we only // apply to n_UV_apply columns of U and V since this is the most we // need to touch given the most recent value stored to m_GH_sweep_max. - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - min_m_n, - n_UV_apply, - n_iter_prev, - buff_G, rs_G, cs_G, - buff_RG, rs_RG, cs_RG, - b_alg ); - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - min_m_n, - n_UV_apply, - n_iter_prev, - buff_H, rs_H, cs_H, - buff_RH, rs_RH, cs_RH, - b_alg ); + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + min_m_n, + n_UV_apply, + n_iter_prev, + buff_G, rs_G, cs_G, + buff_RG, rs_RG, cs_RG, + b_alg); + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + min_m_n, + n_UV_apply, + n_iter_prev, + buff_H, rs_H, cs_H, + buff_RH, rs_RH, cs_RH, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF -printf( "FLA_Bsvd_v_opz_var2: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Bsvd_v_opz_var2: total number of iterations performed: %d\n", n_iter_prev); #endif } // Copy the contents of Q to temporary storage. - bl1_zcopymt( BLIS1_NO_TRANSPOSE, - m_U, - m_V, - buff_U, rs_U, cs_U, - buff_W, rs_W, cs_W ); -// W needs to be max_m_n-by-min_m_n!!!!!!!!!!!!!!! + bl1_zcopymt(BLIS1_NO_TRANSPOSE, + m_U, + m_V, + buff_U, rs_U, cs_U, + buff_W, rs_W, cs_W); + // W needs to be max_m_n-by-min_m_n!!!!!!!!!!!!!!! // Multiply U by R, overwriting U. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - 2*m_U, - m_V, - m_V, - &rone, - ( double* )buff_W, rs_W, 2*cs_W, - buff_RG, rs_RG, cs_RG, - &rzero, - ( double* )buff_U, rs_U, 2*cs_U ); - - bl1_zcopymt( BLIS1_NO_TRANSPOSE, - m_V, - m_V, - buff_V, rs_V, cs_V, - buff_W, rs_W, cs_W ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + 2 * m_U, + m_V, + m_V, + &rone, + (double *)buff_W, rs_W, 2 * cs_W, + buff_RG, rs_RG, cs_RG, + &rzero, + (double *)buff_U, rs_U, 2 * cs_U); + + bl1_zcopymt(BLIS1_NO_TRANSPOSE, + m_V, + m_V, + buff_V, rs_V, cs_V, + buff_W, rs_W, cs_W); // Multiply V by R, overwriting V. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - 2*m_V, - m_V, - m_V, - &rone, - ( double* )buff_W, rs_W, 2*cs_W, - buff_RH, rs_RH, cs_RH, - &rzero, - ( double* )buff_V, rs_V, 2*cs_V ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + 2 * m_V, + m_V, + m_V, + &rone, + (double *)buff_W, rs_W, 2 * cs_W, + buff_RH, rs_RH, cs_RH, + &rzero, + (double *)buff_V, rs_V, 2 * cs_V); // Make all the singular values positive. { - integer i; + integer i; double minus_one = bl1_dm1(); - for ( i = 0; i < min_m_n; ++i ) + for (i = 0; i < min_m_n; ++i) { - if ( buff_d[ (i )*inc_d ] < rzero ) + if (buff_d[(i)*inc_d] < rzero) { - buff_d[ (i )*inc_d ] = -buff_d[ (i )*inc_d ]; - + buff_d[(i)*inc_d] = -buff_d[(i)*inc_d]; + // Scale the right singular vectors. - bl1_zdscalv( BLIS1_NO_CONJUGATE, - m_V, - &minus_one, - buff_V + (i )*cs_V, rs_V ); + bl1_zdscalv(BLIS1_NO_CONJUGATE, + m_V, + &minus_one, + buff_V + (i)*cs_V, rs_V); } } } return n_iter_prev; } - diff --git a/src/lapack/dec/chol/front/flamec/lapack_dpotf2.c b/src/lapack/dec/chol/front/flamec/lapack_dpotf2.c index fba4437b3..7226b29f0 100644 --- a/src/lapack/dec/chol/front/flamec/lapack_dpotf2.c +++ b/src/lapack/dec/chol/front/flamec/lapack_dpotf2.c @@ -1,10 +1,13 @@ /* - Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ /* dpotf2.f -- translated by f2c and slightly modified */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Table of constant values */ @@ -21,7 +24,10 @@ static doublereal c_b12 = 1.; /* Builtin functions */ double sqrt(doublereal); - +#ifndef FLA_ENABLE_AOCL_BLAS + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); + logical lsame_(char *ca, char *cb, integer a, integer b); +#endif /* Local variables */ integer j; doublereal ajj; @@ -84,9 +90,9 @@ static doublereal c_b12 = 1.; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) { - *info = -1; + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { + *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < fla_max(1,*n)) { @@ -94,7 +100,7 @@ static doublereal c_b12 = 1.; } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_DPOTF2", &i__1); + xerbla_("LAPACK_DPOTF2", &i__1, (ftnlen)13); return 0; } diff --git a/src/lapack/dec/chol/front/flamec/lapack_dpotrf.c b/src/lapack/dec/chol/front/flamec/lapack_dpotrf.c index 1483eb4fa..4ea4dac1a 100644 --- a/src/lapack/dec/chol/front/flamec/lapack_dpotrf.c +++ b/src/lapack/dec/chol/front/flamec/lapack_dpotrf.c @@ -1,10 +1,13 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc. All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ /* dpotrf.f -- translated by f2c and slightly modified */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Table of constant values */ static integer c__1 = 1; @@ -21,6 +24,12 @@ static doublereal c_b14 = 1.; integer j, jb, nb; logical upper; +#ifndef FLA_ENABLE_AOCL_BLAS + logical lsame_(char *ca, char *cb, integer a, integer b); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); +#endif + int lapack_dpotf2(char *uplo, integer *n, doublereal *a, integer *lda, integer *info); + /* DPOTRF computes the Cholesky factorization of a real symmetric */ /* positive definite matrix A. */ @@ -72,7 +81,7 @@ static doublereal c_b14 = 1.; a -= a_offset; #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -80,9 +89,9 @@ static doublereal c_b14 = 1.; #endif /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) { - *info = -1; + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { + *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < fla_max(1,*n)) { @@ -90,7 +99,7 @@ static doublereal c_b14 = 1.; } if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTRF", &i__1); + xerbla_("DPOTRF", &i__1, (ftnlen)6); return 0; } @@ -128,8 +137,8 @@ static doublereal c_b14 = 1.; i__3 = j - 1; #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("DPOTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("DPOTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif dsyrk_("Upper", "Transpose", &jb, &i__3, &c_b13, &a[j * @@ -172,8 +181,8 @@ static doublereal c_b14 = 1.; i__3 = j - 1; #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("DPOTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("DPOTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/lapack/dec/chol/front/flamec/lapack_spotf2.c b/src/lapack/dec/chol/front/flamec/lapack_spotf2.c index 30a505667..8f7b87e5e 100644 --- a/src/lapack/dec/chol/front/flamec/lapack_spotf2.c +++ b/src/lapack/dec/chol/front/flamec/lapack_spotf2.c @@ -1,8 +1,11 @@ /* - Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Table of constant values */ @@ -19,7 +22,10 @@ static real c_b12 = 1.f; /* Builtin functions */ double sqrt(doublereal); - +#ifndef FLA_ENABLE_AOCL_BLAS + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); + logical lsame_(char *ca, char *cb, integer a, integer b); +#endif /* Local variables */ integer j; real ajj; @@ -78,9 +84,9 @@ static real c_b12 = 1.f; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) { - *info = -1; + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { + *info = -1; } else if (*n < 0) { *info = -2; } else if (*lda < fla_max(1,*n)) { @@ -88,7 +94,7 @@ static real c_b12 = 1.f; } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_SPOTF2", &i__1); + xerbla_("LAPACK_SPOTF2", &i__1, (ftnlen)13); return 0; } diff --git a/src/lapack/dec/chol/front/flamec/lapack_spotrf.c b/src/lapack/dec/chol/front/flamec/lapack_spotrf.c index 125cefbd1..89559bf3b 100644 --- a/src/lapack/dec/chol/front/flamec/lapack_spotrf.c +++ b/src/lapack/dec/chol/front/flamec/lapack_spotrf.c @@ -1,8 +1,12 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc. All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif + /* Table of constant values */ static integer c__1 = 1; @@ -19,7 +23,11 @@ static real c_b14 = 1.f; /* Local variables */ integer j, jb, nb; logical upper; - +#ifndef FLA_ENABLE_AOCL_BLAS + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); + logical lsame_(char *ca, char *cbi, integer a, integer b); +#endif + int lapack_spotf2(char *uplo, integer *n, real *a, integer *lda, integer *info); /* SPOTRF computes the Cholesky factorization of a real symmetric */ /* positive definite matrix A. */ @@ -70,7 +78,7 @@ static real c_b14 = 1.f; a -= a_offset; #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; - step_count=0; + progress_step_count=0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -79,8 +87,9 @@ static real c_b14 = 1.f; #endif /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) { + upper = lsame_(uplo, "U", 1, 1); + + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } else if (*n < 0) { *info = -2; @@ -89,7 +98,7 @@ static real c_b14 = 1.f; } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_SPOTRF", &i__1); + xerbla_("LAPACK_SPOTRF", &i__1, (ftnlen)13); return 0; } @@ -127,8 +136,8 @@ static real c_b14 = 1.f; i__3 = j - 1; #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("SPOTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("SPOTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif ssyrk_("Upper", "Transpose", &jb, &i__3, &c_b13, &a[j * @@ -172,8 +181,8 @@ static real c_b14 = 1.f; i__3 = j - 1; #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("SPOTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("SPOTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif ssyrk_("Lower", "No transpose", &jb, &i__3, &c_b13, &a[j + diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_blk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_blk_var1.c index 6a5470e3b..1e7cee984 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_blk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_blk_var1.c @@ -7,6 +7,7 @@ FLA_Error FLA_LU_nopiv_ic_blk_var1( integer m_A, integer n_A,FLA_Obj A, scomplex* buff_A, integer nfact, integer rs_A, integer cs_A ) { + void* FLA_memset( void* str, integer c, uinteger len ); scomplex* copy_A = (scomplex*)FLA_malloc(m_A*n_A*sizeof(scomplex)); FLA_memset(copy_A,0,sizeof(copy_A)); diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_unblk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_unblk_var1.c index ce6d389c1..aa74dd681 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_unblk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_ic_unblk_var1.c @@ -1,8 +1,11 @@ /* - * Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. * */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /************************************************************************************** This method uses nonrecursive ger based method to calculate ATL,ABL,ATR,ABR implicitly @@ -18,11 +21,9 @@ FLA_Error FLA_LU_nopiv_ic_unblk_var1( integer m_A, integer n_A, scomplex* A , in scomplex *Minusone = &rminusone; scomplex rone = bl1_c1(); scomplex *One = &rone; - scomplex rzero = bl1_c0(); integer inc_x, inc_y, i, diff, tr_m, tr_n, tr_nfe, tr_ne; scomplex alpha_inv; scomplex *alpha; - scomplex cscalinv; tr_m = m_A - nfact; tr_n = n_A - nfact; FLA_Error e_val = FLA_SUCCESS; @@ -74,13 +75,13 @@ FLA_Error FLA_LU_nopiv_ic_unblk_var1( integer m_A, integer n_A, scomplex* A , in // U2 or new ATR = L1^-1 * ATR // ATR size to be updated is e_val x (m_A - nfact) if( tr_m != 0 ) // if size of ATR is 0 then trsm is invalid { - ctrsm_( "L", "L", "N", "U", &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); + ctrsm_( "L", "L", "N", "U", (integer *) &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); } // L2 valid ABL calculation = U1^-1 * valid ABL // ABL size to be updated is (n_A - nfact) * e_val if( tr_n != 0 ) // base invalid cases when size of ABL is 0, nfact=1 case handled seperately { - ctrsm_( "R", "U", "N", "N", &tr_n, &e_val, One, A, &cs_A, (A + nfact), &cs_A ); + ctrsm_( "R", "U", "N", "N", &tr_n, (integer *) &e_val, One, A, &cs_A, (A + nfact), &cs_A ); } // new ABR1 = ABR1 - valid ABL * valid updated nfact block @@ -89,14 +90,14 @@ FLA_Error FLA_LU_nopiv_ic_unblk_var1( integer m_A, integer n_A, scomplex* A , in if( ( tr_n != 0 ) ) // base invalid cases check { tr_nfe = nfact - e_val; - cgemm_( "N", "N", &tr_n, &(tr_nfe), &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); + cgemm_( "N", "N", &tr_n, &(tr_nfe), (integer *) &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); } // new ABR2 = ABR2 - valid ATR * (valid updated ATL's ABL part + new ABL) if( ( tr_m != 0 ) ) { tr_ne = n_A - e_val; - cgemm_( "N", "N", &(tr_ne), &tr_m, &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); + cgemm_( "N", "N", &(tr_ne), &tr_m, (integer *) &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); } } diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_blk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_blk_var1.c index 20efb8515..56ba490de 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_blk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_blk_var1.c @@ -7,6 +7,7 @@ FLA_Error FLA_LU_nopiv_id_blk_var1( integer m_A, integer n_A, FLA_Obj A, double* buff_A, integer nfact, integer rs_A, integer cs_A ) { + void* FLA_memset( void* str, integer c, uinteger len ); double* copy_A = (double*)FLA_malloc(m_A*n_A*sizeof(double)); FLA_memset(copy_A,0,sizeof(copy_A)); diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var1.c index 6983c7d5e..20846ceb7 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var1.c @@ -1,8 +1,11 @@ /* - * Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. * */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /************************************************************************************** This method uses nonrecursive ger based method to calculate ATL,ABL,ATR,ABR implicitly @@ -18,7 +21,6 @@ FLA_Error FLA_LU_nopiv_id_unblk_var1( integer m_A, integer n_A, double* A , inte double *Minusone = &rminusone; double rone = bl1_d1(); double *One = &rone; - double rzero = bl1_d0(); integer inc_x, inc_y, i, diff, tr_m, tr_n, tr_nfe, tr_ne; double alpha_inv; double *alpha; @@ -85,13 +87,13 @@ FLA_Error FLA_LU_nopiv_id_unblk_var1( integer m_A, integer n_A, double* A , inte // U2 or new ATR = L1^-1 * ATR // ATR size to be updated is e_val x (m_A - nfact) if( tr_m != 0 ) // if size of ATR is 0 then trsm is invalid { - dtrsm_( "L", "L", "N", "U", &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); + dtrsm_( "L", "L", "N", "U", (integer *) &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); } // L2 valid ABL calculation = U1^-1 * valid ABL // ABL size to be updated is (n_A - nfact) * e_val if( tr_n != 0 ) // base invalid cases when size of ABL is 0, nfact=1 case handled seperately { - dtrsm_( "R", "U", "N", "N", &tr_n, &e_val, One, A, &cs_A, (A + nfact), &cs_A ); + dtrsm_( "R", "U", "N", "N", &tr_n, (integer *) &e_val, One, A, &cs_A, (A + nfact), &cs_A ); } // new ABR1 = ABR1 - valid ABL * valid updated nfact block @@ -100,14 +102,14 @@ FLA_Error FLA_LU_nopiv_id_unblk_var1( integer m_A, integer n_A, double* A , inte if( ( tr_n != 0 ) ) // base invalid cases check { tr_nfe = nfact - e_val; - dgemm_( "N", "N", &tr_n, &tr_nfe, &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); + dgemm_( "N", "N", &tr_n, &tr_nfe, (integer *) &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); } // new ABR2 = ABR2 - valid ATR * (valid updated ATL's ABL part + new ABL) if( ( tr_m != 0 ) ) { tr_ne = n_A - e_val; - dgemm_( "N", "N", &tr_ne, &tr_m, &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); + dgemm_( "N", "N", &tr_ne, &tr_m, (integer *) &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); } } diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var2.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var2.c index fa2e0e8b2..dde513819 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var2.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_id_unblk_var2.c @@ -1,8 +1,11 @@ /* - * Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. * */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /******************************************************************************************* This algorithm uses noncrecursive nonpivot based LU factorization using same logic as getrf @@ -18,9 +21,6 @@ FLA_Error FLA_LU_nopiv_id_unblk_var2( integer m_A, integer n_A, double* A, integ { double rminusone = bl1_dm1(); double *Minusone = &rminusone; - double rone = bl1_d1(); - double *One = &rone; - double rzero = bl1_d0(); integer inc_x, inc_y, i, mdiff, ndiff; double alpha_inv; double *alpha; diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_blk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_blk_var1.c index 488c74119..c2d27cf83 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_blk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_blk_var1.c @@ -6,7 +6,7 @@ FLA_Error FLA_LU_nopiv_is_blk_var1( integer m_A, integer n_A, FLA_Obj A, float* buff_A, integer nfact, integer rs_A, integer cs_A ) { - + void* FLA_memset( void* str, integer c, uinteger len ); float* copy_A = (float*)FLA_malloc(m_A*n_A*sizeof(float)); FLA_memset(copy_A,0,sizeof(copy_A)); diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_unblk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_unblk_var1.c index d625f4e70..f2bf0a036 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_unblk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_is_unblk_var1.c @@ -1,8 +1,11 @@ /* - * Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. * */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /************************************************************************************** This method uses nonrecursive ger based method to calculate ATL,ABL,ATR,ABR implicitly @@ -18,7 +21,6 @@ FLA_Error FLA_LU_nopiv_is_unblk_var1( integer m_A, integer n_A, float* A , integ float *Minusone = &rminusone; float rone = bl1_s1(); float *One = &rone; - float rzero = bl1_s0(); integer inc_x, inc_y, i, diff, tr_m, tr_n, tr_nfe, tr_ne; float alpha_inv; float *alpha; @@ -85,13 +87,13 @@ FLA_Error FLA_LU_nopiv_is_unblk_var1( integer m_A, integer n_A, float* A , integ // U2 or new ATR = L1^-1 * ATR // ATR size to be updated is e_val x (m_A - nfact) if( tr_m != 0 ) // if size of ATR is 0 then trsm is invalid { - strsm_( "L", "L", "N", "U", &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); + strsm_( "L", "L", "N", "U", (integer *) &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); } // L2 valid ABL calculation = U1^-1 * valid ABL // ABL size to be updated is (n_A - nfact) * e_val if( tr_n != 0 ) // base invalid cases when size of ABL is 0, nfact=1 case handled seperately { - strsm_( "R", "U", "N", "N", &tr_n, &e_val, One, A, &cs_A, (A + nfact), &cs_A ); + strsm_( "R", "U", "N", "N", &tr_n, (integer *) &e_val, One, A, &cs_A, (A + nfact), &cs_A ); } @@ -101,14 +103,14 @@ FLA_Error FLA_LU_nopiv_is_unblk_var1( integer m_A, integer n_A, float* A , integ if( ( tr_n != 0 ) ) // base invalid cases check { tr_nfe = nfact - e_val; - sgemm_( "N", "N", &tr_n, &tr_nfe, &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); + sgemm_( "N", "N", &tr_n, &tr_nfe, (integer *) &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); } // new ABR2 = ABR2 - valid ATR * (valid updated ATL's ABL part + new ABL) if( ( tr_m != 0 ) ) { tr_ne = n_A - e_val; - sgemm_( "N", "N", &tr_ne, &tr_m, &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); + sgemm_( "N", "N", &tr_ne, &tr_m, (integer *) &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); } } diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_blk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_blk_var1.c index 3b6d9f00c..2c0d48153 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_blk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_blk_var1.c @@ -7,6 +7,7 @@ FLA_Error FLA_LU_nopiv_iz_blk_var1( integer m_A, integer n_A, FLA_Obj A, dcomplex* buff_A, integer nfact, integer rs_A, integer cs_A ) { + void* FLA_memset( void* str, integer c, uinteger len ); dcomplex* copy_A = (dcomplex*)FLA_malloc(m_A*n_A*sizeof(dcomplex)); FLA_memset(copy_A,0,sizeof(copy_A)); diff --git a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_unblk_var1.c b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_unblk_var1.c index 2e883700a..8357244f3 100644 --- a/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_unblk_var1.c +++ b/src/lapack/dec/lu/nopiv/vars/flamec/FLA_LU_nopiv_iz_unblk_var1.c @@ -1,8 +1,11 @@ /* - * Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. * */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /************************************************************************************** This method uses nonrecursive ger based method to calculate ATL,ABL,ATR,ABR implicitly @@ -18,11 +21,9 @@ FLA_Error FLA_LU_nopiv_iz_unblk_var1( integer m_A, integer n_A, dcomplex* A , in dcomplex *Minusone = &rminusone; dcomplex rone = bl1_z1(); dcomplex *One = &rone; - dcomplex rzero = bl1_z0(); integer inc_x, inc_y, i, diff, tr_m, tr_n, tr_nfe, tr_ne; dcomplex alpha_inv; dcomplex *alpha; - dcomplex zscalinv; tr_m = m_A - nfact; tr_n = n_A - nfact; FLA_Error e_val = FLA_SUCCESS; @@ -74,13 +75,13 @@ FLA_Error FLA_LU_nopiv_iz_unblk_var1( integer m_A, integer n_A, dcomplex* A , in // U2 or new ATR = L1^-1 * ATR // ATR size to be updated is e_val x (m_A - nfact) if( tr_m != 0 ) // if size of ATR is 0 then trsm is invalid { - ztrsm_( "L", "L", "N", "U", &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); + ztrsm_( "L", "L", "N", "U", (integer *) &e_val, &tr_m, One, A, &cs_A, (A + cs_A * nfact), &cs_A ); } // L2 valid ABL calculation = U1^-1 * valid ABL // ABL size to be updated is (n_A - nfact) * e_val if( tr_n != 0 ) // base invalid cases when size of ABL is 0, nfact=1 case handled seperately { - ztrsm_( "R", "U", "N", "N", &tr_n, &e_val, One, A, &cs_A, (A + nfact), &cs_A ); + ztrsm_( "R", "U", "N", "N", &tr_n, (integer *) &e_val, One, A, &cs_A, (A + nfact), &cs_A ); } // new ABR1 = ABR1 - valid ABL * valid updated nfact block @@ -89,14 +90,14 @@ FLA_Error FLA_LU_nopiv_iz_unblk_var1( integer m_A, integer n_A, dcomplex* A , in if( ( tr_n != 0 ) ) // base invalid cases check { tr_nfe = nfact - e_val; - zgemm_( "N", "N", &tr_n, &tr_nfe, &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); + zgemm_( "N", "N", &tr_n, &tr_nfe, (integer *) &e_val, Minusone, (A + nfact), &cs_A, (A + e_val * cs_A), &cs_A, One, (A + nfact + e_val * cs_A), &cs_A ); } // new ABR2 = ABR2 - valid ATR * (valid updated ATL's ABL part + new ABL) if( ( tr_m != 0 ) ) { tr_ne = n_A - e_val; - zgemm_( "N", "N", &tr_ne, &tr_m, &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); + zgemm_( "N", "N", &tr_ne, &tr_m, (integer *) &e_val, Minusone, (A + e_val), &cs_A, (A + nfact * cs_A), &cs_A, One, (A + e_val + nfact * cs_A), &cs_A ); } } diff --git a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv.h b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv.h index e1ab98c65..03f9d751d 100644 --- a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv.h +++ b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv.h @@ -7,9 +7,11 @@ directory, or at http://opensource.org/licenses/BSD-3-Clause */ + /* - * Copyright (c) 2020-2023 Advanced Micro Devices, Inc.  All rights reserved. - */ + Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. +*/ + #include "FLA_LU_piv_vars.h" FLA_Error FLA_LU_piv_internal( FLA_Obj A, FLA_Obj p, fla_lu_t* cntl ); @@ -23,19 +25,21 @@ integer FLA_LU_piv_small_d_var1( integer *m, integer *n, doublereal *a, intege integer *ipiv, integer *info ); integer FLA_LU_piv_small_d_var2( integer *m, integer *n, doublereal *a, integer *lda, integer *ipiv, integer *info ); -integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *lda, +int FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info); -integer FLA_LU_piv_z_var0(integer *m, integer *n, doublecomplex *a, integer *lda, - integer *ipiv, integer *info); -integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, integer *lda, - integer *ipiv, integer *info); +int FLA_LU_piv_z_var0(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info); +int FLA_LU_piv_z_parallel( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info); +integer FLA_LU_piv_small_s_var0( integer *m, integer *n, real *a, integer *lda, + integer *ipiv, integer *info ); +integer FLA_LU_piv_small_s_var1( integer *m, integer *n, real *a, integer *lda, + integer *ipiv, integer *info ); FLA_Error FLA_LU_piv_solve( FLA_Obj A, FLA_Obj p, FLA_Obj B, FLA_Obj X ); FLA_Error FLASH_LU_piv_solve( FLA_Obj A, FLA_Obj p, FLA_Obj B, FLA_Obj X ); -integer lapack_cgetf2(integer *m, integer *n, complex *a, integer *lda, +integer lapack_cgetf2(integer *m, integer *n, scomplex *a, integer *lda, integer *ipiv, integer *info); integer lapack_cgetrf(integer *m, integer *n, scomplex *a, integer *lda, integer *ipiv, integer *info); diff --git a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_d.c b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_d.c index 851ccf25d..896a34732 100644 --- a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_d.c +++ b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_d.c @@ -1,8 +1,11 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* * LU with partial pivoting for tiny matrices @@ -102,8 +105,7 @@ integer FLA_LU_piv_small_d_var1( integer *m, integer *n, /* Local variables */ integer i__, j, jp; extern doublereal dlamch_(char *); - extern integer idamax_(integer *, doublereal *, integer *); - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal sfmin; a_dim1 = *lda; @@ -187,19 +189,15 @@ integer FLA_LU_piv_small_d_var2( integer *m, integer *n, integer *info) { integer c__1 = 1; - integer c_n1 = -1; doublereal c_b16 = 1.; doublereal c_b19 = -1.; integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - doublereal d__1; /* Local variables */ - integer i__, j, jp, jb, nb; + integer i__, j, jb, nb; extern doublereal dlamch_(char *); - extern integer idamax_(integer *, doublereal *, integer *); - extern /* Subroutine */ int xerbla_(char *, integer *); - doublereal sfmin; + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer iinfo; #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] diff --git a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_s.c b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_s.c index 25812a0d6..2fdaf3ab3 100644 --- a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_s.c +++ b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_small_s.c @@ -3,7 +3,13 @@ */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif +#include "fla_lapack_x86_common.h" + +#if FLA_ENABLE_AMD_OPT /* * LU with partial pivoting for tiny matrices * @@ -104,8 +110,9 @@ integer FLA_LU_piv_small_s_var1( integer *m, integer *n, /* Local variables */ integer i__, j, jp; extern real slamch_(char *); - extern integer isamax_(integer *, real *, integer *); - extern /* Subroutine */ int xerbla_(char *, integer *); + extern int fla_sscal(integer *n, real *alpha, real *x, integer *incx); + extern int fla_sger(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, + integer *incy, real *a, integer *lda); real sfmin; a_dim1 = *lda; @@ -165,4 +172,5 @@ integer FLA_LU_piv_small_s_var1( integer *m, integer *n, } } return *info; -} \ No newline at end of file +} +#endif diff --git a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_z.c b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_z.c index 6f171465e..af05e469d 100644 --- a/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_z.c +++ b/src/lapack/dec/lu/piv/front/flamec/FLA_LU_piv_z.c @@ -3,16 +3,25 @@ */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #include "FLA_f2c.h" +#include "fla_lapack_x86_common.h" -#define FLA_LU_SMALL_BLOCK_SIZE 16 +#define FLA_LU_SMALL_BLOCK_SIZE 4096 +#define FLA_LU_SMALL_DIM 32 -static doublecomplex z__1 = { -1, 0}, c_b1 = {1.,0.}; +static dcomplex z__1 = { -1, 0}; +static dcomplex c_b1 = {1.,0.}; static integer c__1 = 1; +#ifdef FLA_ENABLE_AMD_OPT + void FLA_get_optimum_params_zgetrf(integer m, integer n, integer *nb, int *n_threads) { int available_n_threads; + extern int fla_thread_get_num_threads(void); /* Get maximum thread available*/ available_n_threads = fla_thread_get_num_threads(); @@ -72,20 +81,23 @@ void FLA_get_optimum_params_zgetrf(integer m, integer n, integer *nb, int *n_thr * All the computations are done inline without using * corresponding BLAS APIs to reduce function overheads. */ -integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) +int FLA_LU_piv_small_z_var0( integer *m, integer *n, + dcomplex *a, integer *lda, + integer *ipiv, + integer *info) { integer mi, ni; integer i, j, i_1, i_2, i_3; - doublereal max_val, t_val, z_val; - doublecomplex *acur, *apiv, *asrc; + double max_val, t_val, z_val; + dcomplex *acur, *apiv, *asrc; integer p_idx; integer min_m_n = fla_min(*m, *n); #ifndef _WIN32 - doublecomplex z__1; + dcomplex z__1; double _Complex pinv; #else - doublereal piv_r, piv_i; - doublereal pinv; + double piv_r, piv_i; + double pinv; #endif *info = 0; @@ -120,7 +132,7 @@ integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *l p_idx = i; for( i_1 = 0; i_1 < mi; i_1++ ) { - t_val = f2c_abs(acur[i_1].r) + f2c_abs(acur[i_1].i); + t_val = f2c_abs(acur[i_1].real) + f2c_abs(acur[i_1].imag); if( t_val > max_val ) { max_val = t_val; @@ -133,7 +145,7 @@ integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *l ipiv[i] = p_idx + 1; /* Swap rows and calculate a column of L */ - if( apiv[*lda * i].r != 0. || apiv[*lda * i].i != 0. ) + if( apiv[*lda * i].real != 0. || apiv[*lda * i].imag != 0. ) { /* Swap entire rows */ if( p_idx != i ) @@ -141,47 +153,47 @@ integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *l for( i_1 = 0; i_1 < *n ; i_1++ ) { i_2 = i_1 * *lda; - t_val = apiv[i_2].r; - z_val = apiv[i_2].i; - apiv[i_2].r = asrc[i_2].r; - apiv[i_2].i = asrc[i_2].i; - asrc[i_2].r = t_val; - asrc[i_2].i = z_val; + t_val = apiv[i_2].real; + z_val = apiv[i_2].imag; + apiv[i_2].real = asrc[i_2].real; + apiv[i_2].imag = asrc[i_2].imag; + asrc[i_2].real = t_val; + asrc[i_2].imag = z_val; } } /* Calculate scalefactors (L) & update trailing matrix */ #ifndef _WIN32 - pinv = 1.0 / ((*acur).r + (I * (*acur).i)); - z__1.r = creal(pinv); - z__1.i = cimag(pinv); + pinv = 1.0 / ((*acur).real + (I * (*acur).imag)); + z__1.real = creal(pinv); + z__1.imag = cimag(pinv); #else - piv_r = (*acur).r; - piv_i = (*acur).i; + piv_r = (*acur).real; + piv_i = (*acur).imag; pinv = piv_r * piv_r + piv_i * piv_i; #endif for( i_1 = 1; i_1 < mi; i_1++ ) { - t_val = acur[i_1].r; + t_val = acur[i_1].real; #ifndef _WIN32 - acur[i_1].r = (t_val * z__1.r - acur[i_1].i * z__1.i); - acur[i_1].i = (t_val * z__1.i + acur[i_1].i * z__1.r); + acur[i_1].real = (t_val * z__1.real - acur[i_1].imag * z__1.imag); + acur[i_1].imag = (t_val * z__1.imag + acur[i_1].imag * z__1.real); #else - acur[i_1].r = (acur[i_1].i * piv_i + t_val * piv_r) / pinv; - acur[i_1].i = (acur[i_1].i * piv_r - t_val * piv_i) / pinv; + acur[i_1].real = (acur[i_1].imag * piv_i + t_val * piv_r) / pinv; + acur[i_1].imag = (acur[i_1].imag * piv_r - t_val * piv_i) / pinv; #endif - t_val = acur[i_1].r; - z_val = acur[i_1].i; + t_val = acur[i_1].real; + z_val = acur[i_1].imag; for( j = 1; j < ni; j++ ) { i_2 = i_1 + j * *lda; i_3 = j * *lda; - acur[i_2].r = acur[i_2].r - t_val * acur[i_3].r + z_val * acur[i_3].i; - acur[i_2].i = acur[i_2].i - t_val * acur[i_3].i - z_val * acur[i_3].r; + acur[i_2].real = acur[i_2].real - t_val * acur[i_3].real + z_val * acur[i_3].imag; + acur[i_2].imag = acur[i_2].imag - t_val * acur[i_3].imag - z_val * acur[i_3].real; } } } @@ -196,9 +208,9 @@ integer FLA_LU_piv_small_z_var0( integer *m, integer *n, dcomplex *a, integer *l /* LU factorization recursive variant*/ -integer FLA_LU_piv_z_var0(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ipiv, integer *info) +int FLA_LU_piv_z_var0(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) { - integer a_dim1, i__1, i__2, i__, n1, n2; + integer a_dim1, i__1, i__2, i__, n1, n2, block_size; integer iinfo; /* Adjust dimension of the matrix */ @@ -230,16 +242,19 @@ integer FLA_LU_piv_z_var0(integer *m, integer *n, doublecomplex *a, integer *lda return 0; } - if (*m <= FLA_LU_SMALL_BLOCK_SIZE && *n <= FLA_LU_SMALL_BLOCK_SIZE) + /* compute matrix size*/ + block_size = *m * *n; + + if ( (block_size <= FLA_LU_SMALL_BLOCK_SIZE) && ( *m <= FLA_LU_SMALL_DIM || *n <= FLA_LU_SMALL_DIM ) ) { - fla_zgetrf_small_avx2(m, n, a, lda, ipiv, &iinfo); + fla_zgetrf_small_simd(m, n, a, lda, ipiv, &iinfo); - if (*info == 0 && iinfo > 0) - { - *info = iinfo; - } + if (*info == 0 && iinfo > 0) + { + *info = iinfo; + } } - else if (*m <= FLA_LU_SMALL_BLOCK_SIZE || *n <= FLA_LU_SMALL_BLOCK_SIZE) + else if (*m == 1 || *n == 1) { lapack_zgetf2(m, n, a, lda, ipiv, &iinfo); @@ -307,15 +322,33 @@ integer FLA_LU_piv_z_var0(integer *m, integer *n, doublecomplex *a, integer *lda #ifdef FLA_OPENMP_MULTITHREADING +int FLA_LU_piv_z_parallel( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) +{ + +#if FLA_ENABLE_AOCL_BLAS + if(*m < 3000 || *n < 3000) + { + FLA_LU_piv_z_var1_parallel( m, n, a, lda, ipiv, info); + } + else + { + FLA_LU_piv_z_var2_parallel( m, n, a, lda, ipiv, info); + } +#else + FLA_LU_piv_z_var1_parallel( m, n, a, lda, ipiv, info); +#endif + + return 0; +} + /* LU factorization blocked varaiant */ -integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, integer *lda, integer *ipiv, integer *info) +int FLA_LU_piv_z_var1_parallel( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; integer i__, j, s, iinfo; integer jb, jb_prev, jb_offset, nb; integer c__1 = 1; - integer c_n1 = -1; #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] int threads_id, n_threads; @@ -390,7 +423,7 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in // Compute L00 and U00 of diagonal blocks i__3 = *m - j + 1; - FLA_LU_piv_z_var0(&i__3, &jb, &a_ref(j, j), lda, &ipiv[j], &iinfo); + FLA_LU_piv_z_var0(&i__3, &jb, (dcomplex *) &a_ref(j, j), lda, &ipiv[j], &iinfo); if (*info == 0 && iinfo > 0) *info = iinfo + j - 1; @@ -421,12 +454,12 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in i__3 = *n - j - jb_prev + 1; i__4 = j + jb_prev - 1; i__3 = fla_min(i__3, jb_prev); - zlaswp_(&i__3, &a_ref(1, j + jb_prev), lda, &j, &i__4, &ipiv[1], &c__1); + zlaswp_(&i__3, (dcomplex*) &a_ref(1, j + jb_prev), lda, &j, &i__4, &ipiv[1], &c__1); // compute U10 i__3 = *n - j - jb_prev + 1; i__3 = fla_min(i__3, jb_prev); - ztrsm_("Left", "Lower", "No transpose", "Unit", &jb_prev, &i__3, &c_b1, &a_ref(j, j), lda, &a_ref(j, j + jb_prev), lda); + ztrsm_("Left", "Lower", "No transpose", "Unit", &jb_prev, &i__3, &c_b1, (dcomplex*) &a_ref(j, j), lda, (dcomplex*) &a_ref(j, j + jb_prev), lda); // compute L11 * U11 if (j + jb_prev <= *m) @@ -435,7 +468,7 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in i__3 = *m - j - jb_prev + 1; i__4 = *n - j - jb_prev + 1; i__4 = fla_min(i__4, jb_prev); - zgemm_("No transpose", "No transpose", &i__3, &i__4, &jb_prev, &z__1, &a_ref(j + jb_prev, j), lda, &a_ref(j, j + jb_prev), lda, &c_b1, &a_ref(j + jb_prev, j + jb_prev), lda); + zgemm_("No transpose", "No transpose", &i__3, &i__4, &jb_prev, &z__1,(dcomplex*) &a_ref(j + jb_prev, j), lda,(dcomplex*) &a_ref(j, j + jb_prev), lda, &c_b1,(dcomplex*) &a_ref(j + jb_prev, j + jb_prev), lda); } if(s <= i__1) @@ -447,7 +480,7 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in // Compute L00 and U00 of diagonal blocks i__3 = *m - s + 1; - FLA_LU_piv_z_var0(&i__3, &jb, &a_ref(s, s), lda, &ipiv[s], &iinfo); + FLA_LU_piv_z_var0(&i__3, &jb,(dcomplex*) &a_ref(s, s), lda, &ipiv[s], &iinfo); if (*info == 0 && iinfo > 0) *info = iinfo + s - 1; @@ -474,12 +507,12 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in i__3 = *n - j - jb_prev + 1 - jb_prev; i__4 = j + jb_prev - 1; FLA_Thread_get_subrange(threads_id - 1, n_threads - 1, i__3, &i__5, &i__6); - zlaswp_(&i__5, &a_ref(1, j + jb_offset + i__6), lda, &j, &i__4, &ipiv[1], &c__1); + zlaswp_(&i__5,(dcomplex*) &a_ref(1, j + jb_offset + i__6), lda, &j, &i__4, &ipiv[1], &c__1); // compute U10 i__3 = *n - j - jb_prev + 1 - jb_prev; FLA_Thread_get_subrange(threads_id - 1, n_threads - 1, i__3, &i__5, &i__6); - ztrsm_("Left", "Lower", "No transpose", "Unit", &jb_prev, &i__5, &c_b1, &a_ref(j, j), lda, &a_ref(j, j + jb_offset + i__6), lda); + ztrsm_("Left", "Lower", "No transpose", "Unit", &jb_prev, &i__5, &c_b1,(dcomplex*) &a_ref(j, j), lda,(dcomplex*) &a_ref(j, j + jb_offset + i__6), lda); // compute L11 * U11 if (j + jb_prev <= *m) @@ -488,7 +521,7 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in i__3 = *m - j - jb_prev + 1; i__4 = *n - j - jb_prev + 1 - jb_prev; FLA_Thread_get_subrange(threads_id - 1, n_threads - 1, i__4, &i__7, &i__8); - zgemm_("No transpose", "No transpose", &i__3, &i__7, &jb_prev, &z__1, &a_ref(j + jb_prev, j), lda, &a_ref(j, j + jb_offset + i__8), lda, &c_b1, &a_ref(j + jb_prev, j + jb_offset + i__8), lda); + zgemm_("No transpose", "No transpose", &i__3, &i__7, &jb_prev, &z__1,(dcomplex*) &a_ref(j + jb_prev, j), lda,(dcomplex*) &a_ref(j, j + jb_offset + i__8), lda, &c_b1,(dcomplex*) &a_ref(j + jb_prev, j + jb_offset + i__8), lda); } } } @@ -509,7 +542,7 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in i__3 = j - 1; i__4 = j + jb - 1; FLA_Thread_get_subrange(threads_id, n_threads, i__3, &i__5, &i__6); - zlaswp_(&i__5, &a[a_offset + (i__6 * a_dim1)], lda, &j, &i__4, &ipiv[1], &c__1); + zlaswp_(&i__5,(dcomplex*) &a[a_offset + (i__6 * a_dim1)], lda, &j, &i__4, &ipiv[1], &c__1); #pragma omp barrier } } @@ -517,4 +550,258 @@ integer FLA_LU_piv_z_var1_parallel( integer *m, integer *n, doublecomplex *a, in return *info; } -#endif \ No newline at end of file + + + + +#if FLA_ENABLE_AOCL_BLAS + +void parallel_gemm_kernel(obj_t* alpha, obj_t* a, obj_t* b, obj_t* beta, obj_t* c, cntx_t* cntx, rntm_t* rntm, thrcomm_t* gl_comm, integer bli_n_threads, array_t* array) +{ + // Create a thread-local copy of the master thread's rntm_t. + rntm_t rntm_l = *rntm; + rntm_t* restrict rntm_p = &rntm_l; + thrinfo_t* thread = NULL; + + // Query the thread's id from OpenMP. + const dim_t tid = omp_get_thread_num(); + + // Use the thread id to access the appropriate pool_t* within the array_t + bli_sba_rntm_set_pool( tid, array, rntm_p ); + + // Create the root node of the thread's thrinfo_t structure. + bli_l3_sup_thrinfo_create_root( tid, gl_comm, rntm_p, &thread ); + + // Call to kernel + bli_gemmsup_int( alpha, a, b, beta, c, cntx, rntm_p, thread); + + // Free the current thread's thrinfo_t structure. + bli_l3_sup_thrinfo_free( rntm_p, thread ); + + return; +} + +/* LU factorization BLIS framework variant */ +int FLA_LU_piv_z_var2_parallel( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11; + dcomplex z__1 = {-1, 0}; + integer i__, j, iinfo; + integer jb, nb; + dcomplex c_b1 = {1.,0.}; + integer c__1 = 1; + integer c_n1 = -1; + integer x; + #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 + #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] + int threads_id, n_threads, threads_ids, r_thread, c_thread; + obj_t alphao = BLIS_OBJECT_INITIALIZER_1X1; + obj_t ao = BLIS_OBJECT_INITIALIZER; + obj_t bo = BLIS_OBJECT_INITIALIZER; + obj_t betao = BLIS_OBJECT_INITIALIZER_1X1; + obj_t co = BLIS_OBJECT_INITIALIZER; + const num_t dt = BLIS_DCOMPLEX; + integer m0, n0, k0; + dim_t m0_a, n0_a; + dim_t m0_b, n0_b; + trans_t blis_transa, blis_transb; + cntx_t* cntx = NULL; + rntm_t* rntm = NULL; + rntm_t rntm_l; + integer bli_n_threads; + thrcomm_t* gl_comm; + array_t* array; + + // Quick return if possible + if (*m == 0 || *n == 0) + return 0; + + a_dim1 = *lda; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + --ipiv; + + /* BLIS framework start */ + + /* Set the row and column strides of the matrix operands. */ + const inc_t rs_a = 1; + const inc_t cs_a = *lda; + const inc_t rs_b = 1; + const inc_t cs_b = *lda; + const inc_t rs_c = 1; + const inc_t cs_c = *lda; + + /* Initialize BLIS. */ + bli_init_auto(); + + /* Map BLAS chars to their corresponding BLIS enumerated type value. */ + bli_param_map_netlib_to_blis_trans( 'n', &blis_transa ); + bli_param_map_netlib_to_blis_trans( 'n', &blis_transb ); + + bli_obj_init_finish_1x1( dt, &z__1, &alphao ); + bli_obj_init_finish_1x1( dt, &c_b1, &betao ); + + // Obtain a valid context from the gks if necessary. + if ( cntx == NULL ) + cntx = bli_gks_query_cntx(); + + // Initialize a local runtime with global settings if necessary. + if ( rntm == NULL ) + { + bli_rntm_init_from_global( &rntm_l ); + rntm = &rntm_l; + } + else + { + rntm_l = *rntm; + rntm = &rntm_l; + } + + /* BLIS framework end */ + + // Determine optimum block and thread size for this environment + FLA_get_optimum_params_zgetrf(*m, *n, &nb, &n_threads); + + /*----------------blocked LU algorithm------------------------- + A00 | A01 L00 | 0 U00 | U01 + ----|----------- ==> ----|------- ----|---------- + | | * | + A10 | A11 L10 | L11 0 | U11 + | | | + 1. Step 1 => compute L00 and U00 + A00 = L00 * U00 + 2. Step 2 => Compute U01 + A01 = L00 * U01 + 3. Step 3 => compute L10 + A10 = L10 * U00 + 4. Compute L11 * U11 + A11 = L10 * U01 + L11 * U11 + ------------------------------------------------------------------*/ + i__1 = fla_min(*m,*n); + i__2 = nb; + + #pragma omp parallel num_threads(n_threads) private(i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11, j, threads_id) + { + threads_id = omp_get_thread_num(); + for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) + { + #pragma omp single + { + // Computing MIN + i__3 = fla_min(*m,*n) - j + 1; + jb = fla_min(i__3,nb); + + // Compute L00 and U00 of diagonal blocks + i__3 = *m - j + 1; + lapack_zgetf2(&i__3, &jb, &a_ref(j, j), lda, &ipiv[j], &iinfo); + + if (*info == 0 && iinfo > 0) + *info = iinfo + j - 1; + + // Computing MIN + i__4 = *m, i__5 = j + jb - 1; + i__3 = fla_min(i__4,i__5); + for (i__ = j; i__ <= i__3; ++i__) + { + ipiv[i__] = j - 1 + ipiv[i__]; + } + + // BLIS framework start + + i__3 = *m - j - jb + 1; + i__4 = *n - j - jb + 1; + + /* Typecast BLAS integers to BLIS integers. */ + bli_convert_blas_dim1( i__3, m0 ); + bli_convert_blas_dim1( i__4, n0 ); + bli_convert_blas_dim1( jb, k0 ); + + bli_set_dims_with_trans( blis_transa, m0, k0, &m0_a, &n0_a ); + bli_set_dims_with_trans( blis_transb, k0, n0, &m0_b, &n0_b ); + + bli_obj_init_finish( dt, m0_a, n0_a, (dcomplex*)&a_ref(j + jb, j), rs_a, cs_a, &ao ); + bli_obj_init_finish( dt, m0_b, n0_b, (dcomplex*)&a_ref(j, j + jb), rs_b, cs_b, &bo ); + bli_obj_init_finish( dt, m0, n0, (dcomplex*)&a_ref(j + jb, j + jb), rs_c, cs_c, &co ); + + bli_obj_set_conjtrans( blis_transa, &ao ); + bli_obj_set_conjtrans( blis_transb, &bo ); + + // Dynamic threading + bli_nthreads_optimum(&ao, &bo, &co, BLIS_GEMM, rntm ); + + // Parse and interpret the contents of the rntm_t object to properly + // set the ways of parallelism for each loop. + bli_rntm_set_ways_from_rntm_sup( bli_obj_length( &co ), bli_obj_width( &co ), bli_obj_width( &ao ), rntm ); + + // Query the total number of threads from the rntm_t object. + bli_n_threads = bli_rntm_num_threads( rntm ); + + // Check out an array_t from the small block allocator. + array = bli_sba_checkout_array( bli_n_threads ); + + // Access the pool_t* for thread 0 and embed it into the rntm. + bli_sba_rntm_set_pool( 0, array, rntm ); + + // Set the packing block allocator field of the rntm. + bli_pba_rntm_set_pba( rntm ); + + // Allcoate a global communicator for the root thrinfo_t structures. + //thrcomm_t* restrict gl_comm = bli_thrcomm_create( rntm, n_threads ); + gl_comm = bli_thrcomm_create( rntm, bli_n_threads ); + + // BLIS framework end + } + + if (j + jb <= *n) + { + // Apply interchanges to columns J+JB:N + i__3 = *n - j - jb + 1; + i__4 = j + jb - 1; + FLA_Thread_get_subrange(threads_id, n_threads, i__3, &i__5, &i__6); + zlaswp_(&i__5, &a_ref(1, j + jb + i__6), lda, &j, &i__4, &ipiv[1], &c__1); + + // compute U10 + i__3 = *n - j - jb + 1; + FLA_Thread_get_subrange(threads_id, n_threads, i__3, &i__5, &i__6); + ztrsm_("Left", "Lower", "No transpose", "Unit", &jb, &i__5, &c_b1, &a_ref(j, j), lda, &a_ref(j, j + jb + i__6), lda); + + #pragma omp barrier + + // compute L11 * U11 + if (j + jb <= *m) + { + /* Update trailing submatrix. */ + parallel_gemm_kernel(&alphao, &ao, &bo, &betao, &co, cntx, rntm, gl_comm, bli_n_threads, array); + } + } + + #pragma omp single + { + bli_sba_checkin_array( array ); + } + } + } + + #pragma omp parallel num_threads(n_threads) private(j, i__3, i__4, i__5, i__6, jb, threads_id) + { + threads_id = omp_get_thread_num(); + for (j = 1; j <= i__1; j += i__2) + { + // Computing MIN + i__3 = fla_min(*m,*n) - j + 1; + jb = fla_min(i__3,nb); + i__3 = j - 1; + i__4 = j + jb - 1; + FLA_Thread_get_subrange(threads_id, n_threads, i__3, &i__5, &i__6); + zlaswp_(&i__5,(dcomplex*) &a[a_offset + (i__6 * a_dim1)], lda, &j, &i__4, &ipiv[1], &c__1); + #pragma omp barrier + } + } + return *info; +} + +#endif + +#endif +#endif diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_cgetf2.c b/src/lapack/dec/lu/piv/front/flamec/lapack_cgetf2.c index 72ac144a4..8f4413311 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_cgetf2.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_cgetf2.c @@ -1,10 +1,13 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif -/* Subroutine */ integer lapack_cgetf2(integer *m, integer *n, complex *a, integer *lda, +/* Subroutine */ integer lapack_cgetf2(integer *m, integer *n, scomplex *a, integer *lda, integer *ipiv, integer *info) { @@ -65,13 +68,13 @@ /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + scomplex q__1; /* Builtin functions */ - void c_div(complex *, complex *, complex *); + void c_div(scomplex *, complex *, scomplex *); /* Local variables */ static TLS_CLASS_SPEC integer j; static TLS_CLASS_SPEC integer jp; - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] @@ -92,7 +95,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_CGETF2", &i__1); + xerbla_("LAPACK_CGETF2", &i__1, (ftnlen)13); return 0; } @@ -111,7 +114,7 @@ jp = j - 1 + icamax_(&i__2, &a_ref(j, j), &c__1); ipiv[j] = jp; i__2 = a_subscr(jp, j); - if (a[i__2].r != 0.f || a[i__2].i != 0.f) { + if (a[i__2].real != 0.f || a[i__2].imag != 0.f) { /* Apply the interchange to columns 1:N. */ @@ -138,7 +141,7 @@ i__2 = *m - j; i__3 = *n - j; - q__1.r = -1.f, q__1.i = 0.f; + q__1.real = -1.f, q__1.imag = 0.f; cgeru_(&i__2, &i__3, &q__1, &a_ref(j + 1, j), &c__1, &a_ref(j, j + 1), lda, &a_ref(j + 1, j + 1), lda); } diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_cgetrf.c b/src/lapack/dec/lu/piv/front/flamec/lapack_cgetrf.c index b400e1484..f1958055b 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_cgetrf.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_cgetrf.c @@ -1,8 +1,11 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Subroutine */ integer lapack_cgetrf(integer *m, integer *n, scomplex *a, integer *lda, integer *ipiv, integer *info) @@ -60,18 +63,18 @@ Parameter adjustments */ /* Table of constant values */ - static TLS_CLASS_SPEC complex c_b1 = {1.f,0.f}; + static TLS_CLASS_SPEC scomplex c_b1 = {1.f,0.f}; static TLS_CLASS_SPEC integer c__1 = 1; static TLS_CLASS_SPEC integer c_n1 = -1; /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1; + scomplex q__1; /* Local variables */ static TLS_CLASS_SPEC integer i__, j; static TLS_CLASS_SPEC integer iinfo; static TLS_CLASS_SPEC integer jb, nb; - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *,integer *, integer *); #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] @@ -96,7 +99,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_CGETRF", &i__1); + xerbla_("LAPACK_CGETRF", &i__1, (ftnlen)13); return 0; } @@ -120,8 +123,8 @@ aocl_fla_progress_ptr=aocl_fla_progress; #endif if(aocl_fla_progress_ptr){ - step_count= fla_min(*m,*n); - AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF",6,&step_count,&thread_id,&total_threads); + progress_step_count= fla_min(*m,*n); + AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -130,7 +133,7 @@ /* Use blocked code. */ #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #endif @@ -148,8 +151,8 @@ aocl_fla_progress_ptr=aocl_fla_progress; #endif if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -199,7 +202,7 @@ i__3 = *m - j - jb + 1; i__4 = *n - j - jb + 1; - q__1.r = -1.f, q__1.i = 0.f; + q__1.real = -1.f, q__1.imag = 0.f; cgemm_("No transpose", "No transpose", &i__3, &i__4, &jb, &q__1, &a_ref(j + jb, j), lda, &a_ref(j, j + jb), lda, &c_b1, &a_ref(j + jb, j + jb), lda); diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_sgetf2.c b/src/lapack/dec/lu/piv/front/flamec/lapack_sgetf2.c index b4ab56ce7..814d6898b 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_sgetf2.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_sgetf2.c @@ -1,8 +1,11 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Subroutine */ integer lapack_sgetf2(integer *m, integer *n, real *a, integer *lda, integer *ipiv, integer *info) @@ -68,8 +71,7 @@ /* Local variables */ static TLS_CLASS_SPEC integer j; static TLS_CLASS_SPEC integer jp; - extern /* Subroutine */ int xerbla_(char *, integer *); - extern integer isamax_(integer *, real *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); int kn; float safmin; float a_piv; @@ -92,7 +94,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_SGETF2", &i__1); + xerbla_("LAPACK_SGETF2", &i__1, (ftnlen)13); return 0; } diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_sgetrf.c b/src/lapack/dec/lu/piv/front/flamec/lapack_sgetrf.c index 3559331ac..aea62ab18 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_sgetrf.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_sgetrf.c @@ -1,8 +1,12 @@ /* - Copyright (c) 2021-2022 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif + /* Table of constant values */ static TLS_CLASS_SPEC integer c__1 = 1; @@ -21,6 +25,7 @@ static TLS_CLASS_SPEC real c_b12 = 1.f; extern integer ilaenv_(integer *, char *, char *, integer *, integer *,integer *, integer *); extern /* Subroutine */ int slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); + extern int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* ======= */ @@ -102,7 +107,7 @@ static TLS_CLASS_SPEC real c_b12 = 1.f; } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_SGETRF", &i__1); + xerbla_("LAPACK_SGETRF", &i__1, (ftnlen)13); return *info; } @@ -125,8 +130,8 @@ static TLS_CLASS_SPEC real c_b12 = 1.f; aocl_fla_progress_ptr=aocl_fla_progress; #endif if(aocl_fla_progress_ptr){ - step_count= fla_min(*m,*n); - AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF",6,&step_count,&thread_id,&total_threads); + progress_step_count= fla_min(*m,*n); + AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -135,8 +140,8 @@ static TLS_CLASS_SPEC real c_b12 = 1.f; /* Use blocked code. */ #if AOCL_FLA_PROGRESS_H - step_count =0; - #endif + progress_step_count = 0; + #endif i__1 = fla_min(*m,*n); @@ -154,8 +159,8 @@ static TLS_CLASS_SPEC real c_b12 = 1.f; aocl_fla_progress_ptr=aocl_fla_progress; #endif if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_zgetf2.c b/src/lapack/dec/lu/piv/front/flamec/lapack_zgetf2.c index 38c528ec5..f8401f28a 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_zgetf2.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_zgetf2.c @@ -3,6 +3,9 @@ */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Subroutine */ integer lapack_zgetf2(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) @@ -66,12 +69,12 @@ integer a_dim1, a_offset, i__1, i__2, i__3; dcomplex z__1; /* Builtin functions */ - void z_div(doublecomplex *, doublecomplex *, doublecomplex *); + void z_div(dcomplex *, dcomplex *, dcomplex *); /* Local variables */ static TLS_CLASS_SPEC integer j; static TLS_CLASS_SPEC integer jp; - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] @@ -92,7 +95,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_ZGETF2", &i__1); + xerbla_("LAPACK_ZGETF2", &i__1, (ftnlen)13); return 0; } diff --git a/src/lapack/dec/lu/piv/front/flamec/lapack_zgetrf.c b/src/lapack/dec/lu/piv/front/flamec/lapack_zgetrf.c index 4fe777179..4d7a6a12d 100644 --- a/src/lapack/dec/lu/piv/front/flamec/lapack_zgetrf.c +++ b/src/lapack/dec/lu/piv/front/flamec/lapack_zgetrf.c @@ -3,6 +3,9 @@ */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif /* Subroutine */ integer lapack_zgetrf(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) @@ -70,7 +73,7 @@ /* Local variables */ static TLS_CLASS_SPEC integer i__, j, iinfo; static TLS_CLASS_SPEC integer jb, nb; - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *,integer *, integer *); #define a_subscr(a_1,a_2) (a_2)*a_dim1 + a_1 #define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)] @@ -95,7 +98,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("LAPACK_ZGETRF", &i__1); + xerbla_("LAPACK_ZGETRF", &i__1, (ftnlen)13); return 0; } @@ -114,13 +117,12 @@ #if AOCL_FLA_PROGRESS_H #ifndef FLA_ENABLE_WINDOWS_BUILD - if(!aocl_fla_progress_ptr) + if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; - #endif - + #endif if(aocl_fla_progress_ptr){ - step_count= fla_min(*m,*n); - AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF",6,&step_count,&thread_id,&total_threads); + progress_step_count= fla_min(*m,*n); + AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -130,8 +132,8 @@ /* Use blocked code. */ #if AOCL_FLA_PROGRESS_H - step_count =0; - #endif + progress_step_count =0; + #endif i__1 = fla_min(*m,*n); i__2 = nb; @@ -141,17 +143,16 @@ jb = fla_min(i__3,nb); - #if AOCL_FLA_PROGRESS_H + #if AOCL_FLA_PROGRESS_H #ifndef FLA_ENABLE_WINDOWS_BUILD - if(!aocl_fla_progress_ptr) - aocl_fla_progress_ptr=aocl_fla_progress; + if(!aocl_fla_progress_ptr) + aocl_fla_progress_ptr=aocl_fla_progress; #endif - - if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF",6,&step_count,&thread_id,&total_threads); - } - #endif + if(aocl_fla_progress_ptr){ + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); + } + #endif /* Factor diagonal and subdiagonal blocks and test for exact diff --git a/src/lapack/dec/q/qrut/vars/flamec/FLA_EXT_geqrf.c b/src/lapack/dec/q/qrut/vars/flamec/FLA_EXT_geqrf.c index cb5a0e1ea..7973d147b 100644 --- a/src/lapack/dec/q/qrut/vars/flamec/FLA_EXT_geqrf.c +++ b/src/lapack/dec/q/qrut/vars/flamec/FLA_EXT_geqrf.c @@ -1,9 +1,12 @@ /* - Copyright (c) 2021 Advanced Micro Devices, Inc.  All rights reserved. + Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. May 09, 2021 */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #define ssign( x ) ( (x) < 0.0F ? -1.0F : 1.0F ) #define dsign( x ) ( (x) < 0.0 ? -1.0 : 1.0 ) diff --git a/src/lapack/dec/svd/ext/flamec/FLA_Svd_ext_u_unb_var1.c b/src/lapack/dec/svd/ext/flamec/FLA_Svd_ext_u_unb_var1.c index bd5d69c15..bb2b2dbf9 100644 --- a/src/lapack/dec/svd/ext/flamec/FLA_Svd_ext_u_unb_var1.c +++ b/src/lapack/dec/svd/ext/flamec/FLA_Svd_ext_u_unb_var1.c @@ -10,87 +10,90 @@ #include "FLAME.h" - -FLA_Error FLA_Svd_ext_u_unb_var1( FLA_Svd_type jobu, FLA_Svd_type jobv, - dim_t n_iter_max, - FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V, - dim_t k_accum, - dim_t b_alg ) +FLA_Error FLA_Svd_ext_u_unb_var1(FLA_Svd_type jobu, FLA_Svd_type jobv, + dim_t n_iter_max, + FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V, + dim_t k_accum, + dim_t b_alg) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype dt; FLA_Datatype dt_real; FLA_Datatype dt_comp; - FLA_Obj scale, T, S, rL, rR, d, e, G, H, C; // C is dummy. - dim_t m_A, n_A, min_m_n; - dim_t n_GH; - double crossover_ratio = 17.0 / 9.0; - FLA_Bool u_is_formed = FALSE, - v_is_formed = FALSE; - integer apply_scale; - - n_GH = k_accum; - - m_A = FLA_Obj_length( A ); - n_A = FLA_Obj_width( A ); - min_m_n = fla_min( m_A, n_A ); - dt = FLA_Obj_datatype( A ); - dt_real = FLA_Obj_datatype_proj_to_real( A ); - dt_comp = FLA_Obj_datatype_proj_to_complex( A ); + FLA_Obj scale, T, S, rL, rR, d, e, G, H, C; // C is dummy. + dim_t m_A, n_A, min_m_n; + dim_t n_GH; + double crossover_ratio = 17.0 / 9.0; + FLA_Bool u_is_formed = FALSE, + v_is_formed = FALSE; + integer apply_scale; + + n_GH = k_accum; + + m_A = FLA_Obj_length(A); + n_A = FLA_Obj_width(A); + min_m_n = fla_min(m_A, n_A); + dt = FLA_Obj_datatype(A); + dt_real = FLA_Obj_datatype_proj_to_real(A); + dt_comp = FLA_Obj_datatype_proj_to_complex(A); + + // Create dummy object for C and nullify it to get rid of warning + FLA_Obj_create(dt, 1, 1, 0, 0, &C); + FLA_Obj_nullify(&C); // Create matrices to hold block Householder transformations. - FLA_Bidiag_UT_create_T( A, &T, &S ); + FLA_Bidiag_UT_create_T(A, &T, &S); // Create vectors to hold the realifying scalars. - if ( FLA_Obj_is_complex( A ) ) + if (FLA_Obj_is_complex(A)) { - FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rL ); - FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rR ); + FLA_Obj_create(dt, min_m_n, 1, 0, 0, &rL); + FLA_Obj_create(dt, min_m_n, 1, 0, 0, &rR); } // Create vectors to hold the diagonal and sub-diagonal. - FLA_Obj_create( dt_real, min_m_n, 1, 0, 0, &d ); - FLA_Obj_create( dt_real, min_m_n-1, 1, 0, 0, &e ); + FLA_Obj_create(dt_real, min_m_n, 1, 0, 0, &d); + FLA_Obj_create(dt_real, min_m_n - 1, 1, 0, 0, &e); // Create matrices to hold the left and right Givens scalars. - FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &G ); - FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &H ); + FLA_Obj_create(dt_comp, min_m_n - 1, n_GH, 0, 0, &G); + FLA_Obj_create(dt_comp, min_m_n - 1, n_GH, 0, 0, &H); // Create a real scaling factor. - FLA_Obj_create( dt_real, 1, 1, 0, 0, &scale ); + FLA_Obj_create(dt_real, 1, 1, 0, 0, &scale); - // Scale matrix A if necessary. - FLA_Max_abs_value( A, scale ); + // Scale matrix A if necessary. + FLA_Max_abs_value(A, scale); apply_scale = - ( FLA_Obj_gt( scale, FLA_OVERFLOW_SQUARE_THRES ) == TRUE ) - - ( FLA_Obj_lt( scale, FLA_UNDERFLOW_SQUARE_THRES ) == TRUE ); - - if ( apply_scale ) - FLA_Scal( apply_scale > 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A ); + (FLA_Obj_gt(scale, FLA_OVERFLOW_SQUARE_THRES) == TRUE) - + (FLA_Obj_lt(scale, FLA_UNDERFLOW_SQUARE_THRES) == TRUE); + + if (apply_scale) + FLA_Scal(apply_scale > 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A); - if ( m_A < crossover_ratio * n_A ) + if (m_A < crossover_ratio * n_A) { // Reduce the matrix to bidiagonal form. // Apply scalars to rotate elements on the superdiagonal to the real domain. // Extract the diagonal and superdiagonal from A. - FLA_Bidiag_UT( A, T, S ); - if ( FLA_Obj_is_complex( A ) ) - FLA_Bidiag_UT_realify( A, rL, rR ); - FLA_Bidiag_UT_extract_real_diagonals( A, d, e ); + FLA_Bidiag_UT(A, T, S); + if (FLA_Obj_is_complex(A)) + FLA_Bidiag_UT_realify(A, rL, rR); + FLA_Bidiag_UT_extract_real_diagonals(A, d, e); // Form U and V. - if ( u_is_formed == FALSE ) + if (u_is_formed == FALSE) { - switch ( jobu ) + switch (jobu) { case FLA_SVD_VECTORS_MIN_OVERWRITE: - if ( jobv != FLA_SVD_VECTORS_NONE ) - FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V ); + if (jobv != FLA_SVD_VECTORS_NONE) + FLA_Bidiag_UT_form_V_ext(FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V); v_is_formed = TRUE; // For this case, V should be formed here. U = A; case FLA_SVD_VECTORS_ALL: case FLA_SVD_VECTORS_MIN_COPY: - FLA_Bidiag_UT_form_U_ext( FLA_UPPER_TRIANGULAR, A, T, FLA_NO_TRANSPOSE, U ); + FLA_Bidiag_UT_form_U_ext(FLA_UPPER_TRIANGULAR, A, T, FLA_NO_TRANSPOSE, U); u_is_formed = TRUE; break; case FLA_SVD_VECTORS_NONE: @@ -98,76 +101,76 @@ FLA_Error FLA_Svd_ext_u_unb_var1( FLA_Svd_type jobu, FLA_Svd_type jobv, break; } } - if ( v_is_formed == FALSE ) + if (v_is_formed == FALSE) { - if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE ) + if (jobv == FLA_SVD_VECTORS_MIN_OVERWRITE) { - FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_CONJ_TRANSPOSE, A ); + FLA_Bidiag_UT_form_V_ext(FLA_UPPER_TRIANGULAR, A, S, FLA_CONJ_TRANSPOSE, A); v_is_formed = TRUE; /* and */ - V = A; // This V is actually V^H. + V = A; // This V is actually V^H. // V^H -> V - FLA_Obj_flip_base( &V ); - FLA_Obj_flip_view( &V ); - if ( FLA_Obj_is_complex( A ) ) - FLA_Conjugate( V ); + FLA_Obj_flip_base(&V); + FLA_Obj_flip_view(&V); + if (FLA_Obj_is_complex(A)) + FLA_Conjugate(V); } - else if ( jobv != FLA_SVD_VECTORS_NONE ) + else if (jobv != FLA_SVD_VECTORS_NONE) { - FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V ); + FLA_Bidiag_UT_form_V_ext(FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V); v_is_formed = TRUE; } } // For complex matrices, apply realification transformation. - if ( FLA_Obj_is_complex( A ) && jobu != FLA_SVD_VECTORS_NONE ) + if (FLA_Obj_is_complex(A) && jobu != FLA_SVD_VECTORS_NONE) { FLA_Obj UL, UR; - FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT ); - FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, UL ); + FLA_Part_1x2(U, &UL, &UR, min_m_n, FLA_LEFT); + FLA_Apply_diag_matrix(FLA_RIGHT, FLA_CONJUGATE, rL, UL); } - if ( FLA_Obj_is_complex( A ) && jobv != FLA_SVD_VECTORS_NONE ) + if (FLA_Obj_is_complex(A) && jobv != FLA_SVD_VECTORS_NONE) { FLA_Obj VL, VR; - FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT ); - FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL ); + FLA_Part_1x2(V, &VL, &VR, min_m_n, FLA_LEFT); + FLA_Apply_diag_matrix(FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL); } // Perform a singular value decomposition on the upper bidiagonal matrix. - r_val = FLA_Bsvd_ext_opt_var1( n_iter_max, - d, e, G, H, - jobu, U, jobv, V, - FALSE, C, // C is not referenced - b_alg ); + r_val = FLA_Bsvd_ext_opt_var1(n_iter_max, + d, e, G, H, + jobu, U, jobv, V, + FALSE, C, // C is not referenced + b_alg); } else // if ( crossover_ratio * n_A <= m_A ) { FLA_Obj TQ, R; FLA_Obj AT, - AB; + AB; // Perform a QR factorization on A. - FLA_QR_UT_create_T( A, &TQ ); - FLA_QR_UT( A, TQ ); + FLA_QR_UT_create_T(A, &TQ); + FLA_QR_UT(A, TQ); // Set the lower triangle of R to zero and then copy the upper // triangle of A to R. - FLA_Part_2x1( A, &AT, - &AB, n_A, FLA_TOP ); - FLA_Obj_create( dt, n_A, n_A, 0, 0, &R ); - FLA_Setr( FLA_LOWER_TRIANGULAR, FLA_ZERO, R ); - FLA_Copyr( FLA_UPPER_TRIANGULAR, AT, R ); + FLA_Part_2x1(A, &AT, + &AB, n_A, FLA_TOP); + FLA_Obj_create(dt, n_A, n_A, 0, 0, &R); + FLA_Setr(FLA_LOWER_TRIANGULAR, FLA_ZERO, R); + FLA_Copyr(FLA_UPPER_TRIANGULAR, AT, R); // Form U; if necessary overwrite on A. - if ( u_is_formed == FALSE ) + if (u_is_formed == FALSE) { - switch ( jobu ) + switch (jobu) { case FLA_SVD_VECTORS_MIN_OVERWRITE: U = A; case FLA_SVD_VECTORS_ALL: case FLA_SVD_VECTORS_MIN_COPY: - FLA_QR_UT_form_Q( A, TQ, U ); + FLA_QR_UT_form_Q(A, TQ, U); u_is_formed = TRUE; break; case FLA_SVD_VECTORS_NONE: @@ -175,119 +178,118 @@ FLA_Error FLA_Svd_ext_u_unb_var1( FLA_Svd_type jobu, FLA_Svd_type jobv, break; } } - FLA_Obj_free( &TQ ); + FLA_Obj_free(&TQ); // Reduce the matrix to bidiagonal form. // Apply scalars to rotate elements on the superdiagonal to the real domain. // Extract the diagonal and superdiagonal from A. - FLA_Bidiag_UT( R, T, S ); - if ( FLA_Obj_is_complex( R ) ) - FLA_Bidiag_UT_realify( R, rL, rR ); - FLA_Bidiag_UT_extract_real_diagonals( R, d, e ); + FLA_Bidiag_UT(R, T, S); + if (FLA_Obj_is_complex(R)) + FLA_Bidiag_UT_realify(R, rL, rR); + FLA_Bidiag_UT_extract_real_diagonals(R, d, e); - if ( v_is_formed == FALSE ) + if (v_is_formed == FALSE) { - if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE ) + if (jobv == FLA_SVD_VECTORS_MIN_OVERWRITE) { - FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, R, S, FLA_CONJ_TRANSPOSE, AT ); + FLA_Bidiag_UT_form_V_ext(FLA_UPPER_TRIANGULAR, R, S, FLA_CONJ_TRANSPOSE, AT); v_is_formed = TRUE; /* and */ - V = AT; // This V is actually V^H. + V = AT; // This V is actually V^H. // V^H -> V - FLA_Obj_flip_base( &V ); - FLA_Obj_flip_view( &V ); - if ( FLA_Obj_is_complex( A ) ) - FLA_Conjugate( V ); + FLA_Obj_flip_base(&V); + FLA_Obj_flip_view(&V); + if (FLA_Obj_is_complex(A)) + FLA_Conjugate(V); } - else if ( jobv != FLA_SVD_VECTORS_NONE ) + else if (jobv != FLA_SVD_VECTORS_NONE) { - FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, R, S, FLA_NO_TRANSPOSE, V ); + FLA_Bidiag_UT_form_V_ext(FLA_UPPER_TRIANGULAR, R, S, FLA_NO_TRANSPOSE, V); v_is_formed = TRUE; } } // Apply householder vectors U in R. - FLA_Bidiag_UT_form_U_ext( FLA_UPPER_TRIANGULAR, R, T, FLA_NO_TRANSPOSE, R ); + FLA_Bidiag_UT_form_U_ext(FLA_UPPER_TRIANGULAR, R, T, FLA_NO_TRANSPOSE, R); // Apply the realifying scalars in rL and rR to U and V, respectively. - if ( FLA_Obj_is_complex( A ) && jobu != FLA_SVD_VECTORS_NONE ) + if (FLA_Obj_is_complex(A) && jobu != FLA_SVD_VECTORS_NONE) { FLA_Obj RL, RR; - FLA_Part_1x2( R, &RL, &RR, min_m_n, FLA_LEFT ); - FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, RL ); + FLA_Part_1x2(R, &RL, &RR, min_m_n, FLA_LEFT); + FLA_Apply_diag_matrix(FLA_RIGHT, FLA_CONJUGATE, rL, RL); } - if ( FLA_Obj_is_complex( A ) && jobv != FLA_SVD_VECTORS_NONE ) + if (FLA_Obj_is_complex(A) && jobv != FLA_SVD_VECTORS_NONE) { FLA_Obj VL, VR; - FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT ); - FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL ); + FLA_Part_1x2(V, &VL, &VR, min_m_n, FLA_LEFT); + FLA_Apply_diag_matrix(FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL); } // Perform a singular value decomposition on the bidiagonal matrix. - r_val = FLA_Bsvd_ext_opt_var1( n_iter_max, - d, e, G, H, - jobu, R, jobv, V, - FALSE, C, - b_alg ); + r_val = FLA_Bsvd_ext_opt_var1(n_iter_max, + d, e, G, H, + jobu, R, jobv, V, + FALSE, C, + b_alg); // Multiply R into U, storing the result in A and then copying back // to U. - if ( jobu != FLA_SVD_VECTORS_NONE ) + if (jobu != FLA_SVD_VECTORS_NONE) { FLA_Obj UL, UR; - FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT ); + FLA_Part_1x2(U, &UL, &UR, min_m_n, FLA_LEFT); - if ( jobu == FLA_SVD_VECTORS_MIN_OVERWRITE || - jobv == FLA_SVD_VECTORS_MIN_OVERWRITE ) + if (jobu == FLA_SVD_VECTORS_MIN_OVERWRITE || + jobv == FLA_SVD_VECTORS_MIN_OVERWRITE) { - FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, UL, &C ); - FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, - FLA_ONE, UL, R, FLA_ZERO, C ); - FLA_Copy( C, UL ); - FLA_Obj_free( &C ); + FLA_Obj_create_conf_to(FLA_NO_TRANSPOSE, UL, &C); + FLA_Gemm(FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, + FLA_ONE, UL, R, FLA_ZERO, C); + FLA_Copy(C, UL); + FLA_Obj_free(&C); } else { - FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, - FLA_ONE, UL, R, FLA_ZERO, A ); - FLA_Copy( A, UL ); + FLA_Gemm(FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, + FLA_ONE, UL, R, FLA_ZERO, A); + FLA_Copy(A, UL); } } - FLA_Obj_free( &R ); + FLA_Obj_free(&R); } // Copy the converged eigenvalues to the output vector. - FLA_Copy( d, s ); + FLA_Copy(d, s); // No sort is required as it is applied on FLA_Bsvd. - if ( apply_scale ) - FLA_Scal( apply_scale < 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, s ); + if (apply_scale) + FLA_Scal(apply_scale < 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, s); // When V is overwritten, flip it again. - if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE ) + if (jobv == FLA_SVD_VECTORS_MIN_OVERWRITE) { // Always apply conjugation first wrt dimensions used; then, flip base. - if ( FLA_Obj_is_complex( V ) ) - FLA_Conjugate( V ); - FLA_Obj_flip_base( &V ); + if (FLA_Obj_is_complex(V)) + FLA_Conjugate(V); + FLA_Obj_flip_base(&V); } - FLA_Obj_free( &scale ); - FLA_Obj_free( &T ); - FLA_Obj_free( &S ); + FLA_Obj_free(&scale); + FLA_Obj_free(&T); + FLA_Obj_free(&S); - if ( FLA_Obj_is_complex( A ) ) + if (FLA_Obj_is_complex(A)) { - FLA_Obj_free( &rL ); - FLA_Obj_free( &rR ); + FLA_Obj_free(&rL); + FLA_Obj_free(&rR); } - FLA_Obj_free( &d ); - FLA_Obj_free( &e ); - FLA_Obj_free( &G ); - FLA_Obj_free( &H ); + FLA_Obj_free(&d); + FLA_Obj_free(&e); + FLA_Obj_free(&G); + FLA_Obj_free(&H); return r_val; } - diff --git a/src/lapack/dec/svd/ext/flamec/dgesvd2x2.c b/src/lapack/dec/svd/ext/flamec/dgesvd2x2.c index 31b4a6334..494504a69 100644 --- a/src/lapack/dec/svd/ext/flamec/dgesvd2x2.c +++ b/src/lapack/dec/svd/ext/flamec/dgesvd2x2.c @@ -11,14 +11,15 @@ ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork, integer *info) { - int i__2; - double AAT[4], ATA[4], tempu[4], tempvt[4], temp; + integer i__2; + double tempu[4], tempvt[4], temp; *info = 0; #if LF_AOCL_DTL_LOG_ENABLE char buffer[256]; sprintf(buffer, "dgesvd inputs: jobu %c, jobvt %c, m %d, n %d, lda %d, ldu %d, ldvt %d\n", *jobu, *jobvt, *m, *n, *lda, *ldu, *ldvt); AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif + extern int xerbla_(const char *srname, const integer *info, ftnlen srname_len); // Error checking , here m, n sizes will always be valid because of specific size if (! (*jobu == 'A' || *jobu == 'S' || *jobu == 'O' || *jobu == 'N')) { *info = -1; @@ -52,7 +53,7 @@ //Print error if (*info != 0) { i__2 = -(*info); - xerbla_("DGESVD", &i__2); + xerbla_("DGESVD", &i__2, (ftnlen)6); return 0; } //To account for column major(taking transpose) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dbdsqr.c b/src/lapack/dec/svd/ext/flamec/lapack_dbdsqr.c index 91064b052..6cc16bf3b 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dbdsqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dbdsqr.c @@ -1,6 +1,12 @@ /* dbdsqr.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ - #include "FLAME.h" +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + */ +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #include "FLA_f2c.h" /* Table of constant values */ static doublereal c_b15 = -.125; static integer c__1 = 1; @@ -258,9 +264,11 @@ doublereal cosl; integer isub, iter; doublereal unfl, sinl, cosr, smin, smax, sinr; +#ifndef FLA_ENABLE_AOCL_BLAS extern /* Subroutine */ int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *), dlas2_( doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); - extern logical lsame_(char *, char *); + extern logical lsame_(char *, char *, integer a, integer b); +#endif doublereal oldcs; extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); @@ -273,7 +281,7 @@ int dlasq1_(integer *, doublereal *, doublereal *, doublereal *, integer *), dlasv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal sminoa, thresh; logical rotate; doublereal tolmul; @@ -312,8 +320,8 @@ --work; /* Function Body */ *info = 0; - lower = lsame_(uplo, "L"); - if (! lsame_(uplo, "U") && ! lower) { + lower = lsame_(uplo, "L", 1, 1); + if (! lsame_(uplo, "U", 1, 1) && ! lower) { *info = -1; } else if (*n < 0) { @@ -339,7 +347,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DBDSQR", &i__1); + xerbla_("DBDSQR", &i__1, (ftnlen)6); return 0; } if (*n == 0) { @@ -882,4 +890,4 @@ /* End of DBDSQR */ } /* lapack_dbdsqr */ - \ No newline at end of file + diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgebd2.c b/src/lapack/dec/svd/ext/flamec/lapack_dgebd2.c index 915b4db13..0b3acb79f 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgebd2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgebd2.c @@ -194,7 +194,7 @@ /* Local variables */ integer i__; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -235,7 +235,7 @@ } if (*info < 0) { i__1 = -(*info); - xerbla_("DGEBD2", &i__1); + xerbla_("DGEBD2", &i__1, (ftnlen)6); return 0; } if (*m >= *n) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgebrd.c b/src/lapack/dec/svd/ext/flamec/lapack_dgebrd.c index e252cd030..a03ad18fd 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgebrd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgebrd.c @@ -1,8 +1,13 @@ /* dgebrd.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ - #include "FLAME.h" - #include "FLA_f2c.h" /* Table of constant values */ - static integer c__1 = 1; +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + */ +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif +#include "FLA_f2c.h" /* Table of constant values */ static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; @@ -216,7 +221,7 @@ integer i__, j, nb, nx, ws; integer nbmin, iinfo, minmn; extern /* Subroutine */ - int lapack_dgebd2(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlabrd_(integer *, integer *, integer * , doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *) , xerbla_(char *, integer *); + int lapack_dgebd2(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlabrd_(integer *, integer *, integer * , doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *) , xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwrkx, ldwrky, lwkopt; logical lquery; @@ -256,6 +261,7 @@ #ifdef FLA_ENABLE_AMD_OPT i__2 = 32; #else + integer c__1 = 1; i__2 = ilaenv_(&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1); // , expr subst #endif nb = fla_max(i__1,i__2); @@ -281,7 +287,7 @@ } if (*info < 0) { i__1 = -(*info); - xerbla_("DGEBRD", &i__1); + xerbla_("DGEBRD", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgelq2.c b/src/lapack/dec/svd/ext/flamec/lapack_dgelq2.c index 63e642908..34c66029b 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgelq2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgelq2.c @@ -126,7 +126,7 @@ integer i__, k; doublereal aii; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -164,7 +164,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQ2", &i__1); + xerbla_("DGELQ2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgelqf.c b/src/lapack/dec/svd/ext/flamec/lapack_dgelqf.c index 74e7af31b..436fa5f17 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgelqf.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgelqf.c @@ -213,7 +213,7 @@ static void fla_dtranspose(integer *m, integer *n, /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int lapack_dgelq2(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int lapack_dgelq2(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -261,7 +261,7 @@ static void fla_dtranspose(integer *m, integer *n, } if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQF", &i__1); + xerbla_("DGELQF", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgesdd.c b/src/lapack/dec/svd/ext/flamec/lapack_dgesdd.c index c9a342e53..928cf6515 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgesdd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgesdd.c @@ -243,10 +243,10 @@ int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal * a, integer *l logical wntqa; integer nwork; logical wntqn, wntqo, wntqs; - integer ie, lwork_dorgbr_p_mm__; + integer ie; extern /* Subroutine */ int dbdsdc_(char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); - integer il, lwork_dorgbr_q_nn__; + integer il; extern /* Subroutine */ int lapack_dgebrd(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); @@ -254,7 +254,7 @@ int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal * a, integer *l extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); integer iu; extern /* Subroutine */ - int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); + int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); extern logical disnan_(doublereal *); doublereal bignum; extern /* Subroutine */ @@ -369,7 +369,6 @@ int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal * a, integer *l dgeqrf_(m, n, dum, m, dum, dum, &c_n1, &ierr); lwork_dgeqrf_mn__ = (integer) dum[0]; dorgbr_("Q", n, n, n, dum, n, dum, dum, &c_n1, &ierr); - lwork_dorgbr_q_nn__ = (integer) dum[0]; dorgqr_(m, m, n, dum, m, dum, dum, &c_n1, &ierr); lwork_dorgqr_mm__ = (integer) dum[0]; dorgqr_(m, n, n, dum, m, dum, dum, &c_n1, &ierr); @@ -578,7 +577,6 @@ int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal * a, integer *l dorglq_(m, n, m, &a[a_offset], m, dum, dum, &c_n1, &ierr); lwork_dorglq_mn__ = (integer) dum[0]; dorgbr_("P", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); - lwork_dorgbr_p_mm__ = (integer) dum[0]; lapack_dormbr("P", "R", "T", m, m, m, dum, m, dum, dum, m, dum, &c_n1, & ierr); lwork_dormbr_prt_mm__ = (integer) dum[0]; lapack_dormbr("P", "R", "T", m, n, m, dum, m, dum, dum, m, dum, &c_n1, & ierr); @@ -768,7 +766,7 @@ int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal * a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DGESDD", &i__1); + xerbla_("DGESDD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dgesvd.c b/src/lapack/dec/svd/ext/flamec/lapack_dgesvd.c index c163601aa..cd90b09a6 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dgesvd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dgesvd.c @@ -1,3459 +1,3898 @@ -/* dgesvd.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; - on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ - #include "FLAME.h" - #include "FLA_f2c.h" /* Table of constant values */ - static integer c__6 = 6; - static integer c__0 = 0; -#ifndef FLA_ENABLE_AMD_OPT - static integer c_n1 = -1; +/* dgesvd.f -- translated by f2c (version 20160102). You must link the resulting + object file with libf2c: on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install + libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of + the command line, as in cc *.o -lf2c -lm Source for libf2c is in + /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All + * rights reserved. + */ +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif +#include "FLA_f2c.h" /* Table of constant values */ +#include "fla_lapack_x86_common.h" + +static integer c__6 = 6; +static integer c__0 = 0; +#if !FLA_ENABLE_AMD_OPT +static integer c_n1 = -1; +#else +#include "fla_lapack_x86_common.h" #endif - static doublereal c_b57 = 0.; - static integer c__1 = 1; - static doublereal c_b79 = 1.; - /* > \brief DGESVD computes the singular value decomposition (SVD) for GE matrices */ - /* =========== DOCUMENTATION =========== */ - /* Online html documentation available at */ - /* http://www.netlib.org/lapack/explore-html/ */ - /* > \htmlonly */ - /* > Download DGESVD + dependencies */ - /* > */ - /* > [TGZ] */ - /* > */ - /* > [ZIP] */ - /* > */ - /* > [TXT] */ - /* > \endhtmlonly */ - /* Definition: */ - /* =========== */ - /* SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, */ - /* WORK, LWORK, INFO ) */ - /* .. Scalar Arguments .. */ - /* CHARACTER JOBU, JOBVT */ - /* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N */ - /* .. */ - /* .. Array Arguments .. */ - /* DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ), */ - /* $ VT( LDVT, * ), WORK( * ) */ - /* .. */ - /* > \par Purpose: */ - /* ============= */ - /* > */ - /* > \verbatim */ - /* > */ - /* > DGESVD computes the singular value decomposition (SVD) of a real */ - /* > M-by-N matrix A, optionally computing the left and/or right singular */ - /* > vectors. The SVD is written */ - /* > */ - /* > A = U * SIGMA * transpose(V) */ - /* > */ - /* > where SIGMA is an M-by-N matrix which is zero except for its */ - /* > fla_min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and */ - /* > V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA */ - /* > are the singular values of A; - they are real and non-negative, and */ - /* > are returned in descending order. The first fla_min(m,n) columns of */ - /* > U and V are the left and right singular vectors of A. */ - /* > */ - /* > Note that the routine returns V**T, not V. */ - /* > \endverbatim */ - /* Arguments: */ - /* ========== */ - /* > \param[in] JOBU */ - /* > \verbatim */ - /* > JOBU is CHARACTER*1 */ - /* > Specifies options for computing all or part of the matrix U: */ - /* > = 'A': all M columns of U are returned in array U: */ - /* > = 'S': the first fla_min(m,n) columns of U (the left singular */ - /* > vectors) are returned in the array U; +static doublereal c_b57 = 0.; +static integer c__1 = 1; +static doublereal c_b79 = 1.; +/* > \brief DGESVD computes the singular value decomposition (SVD) for GE + * matrices */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* > \htmlonly */ +/* > Download DGESVD + dependencies */ +/* > */ +/* > [TGZ] */ +/* > */ +/* > [ZIP] */ +/* > */ +/* > [TXT] */ +/* > \endhtmlonly */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, */ +/* WORK, LWORK, INFO ) */ +/* .. Scalar Arguments .. */ +/* CHARACTER JOBU, JOBVT */ +/* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N */ +/* .. */ +/* .. Array Arguments .. */ +/* DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ), */ +/* $ VT( LDVT, * ), WORK( * ) */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > DGESVD computes the singular value decomposition (SVD) of a real */ +/* > M-by-N matrix A, optionally computing the left and/or right singular */ +/* > vectors. The SVD is written */ +/* > */ +/* > A = U * SIGMA * transpose(V) */ +/* > */ +/* > where SIGMA is an M-by-N matrix which is zero except for its */ +/* > fla_min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and */ +/* > V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA */ +/* > are the singular values of A; +they are real and non-negative, and */ +/* > are returned in descending order. The first fla_min(m,n) columns of */ +/* > U and V are the left and right singular vectors of A. */ +/* > */ +/* > Note that the routine returns V**T, not V. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] JOBU */ +/* > \verbatim */ +/* > JOBU is CHARACTER*1 */ +/* > Specifies options for computing all or part of the matrix U: */ +/* > = 'A': all M columns of U are returned in array U: */ +/* > = 'S': the first fla_min(m,n) columns of U (the left singular */ +/* > vectors) are returned in the array U; */ - /* > = 'O': the first fla_min(m,n) columns of U (the left singular */ - /* > vectors) are overwritten on the array A; +/* > = 'O': the first fla_min(m,n) columns of U (the left singular */ +/* > vectors) are overwritten on the array A; */ - /* > = 'N': no columns of U (no left singular vectors) are */ - /* > computed. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] JOBVT */ - /* > \verbatim */ - /* > JOBVT is CHARACTER*1 */ - /* > Specifies options for computing all or part of the matrix */ - /* > V**T: */ - /* > = 'A': all N rows of V**T are returned in the array VT; +/* > = 'N': no columns of U (no left singular vectors) are */ +/* > computed. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] JOBVT */ +/* > \verbatim */ +/* > JOBVT is CHARACTER*1 */ +/* > Specifies options for computing all or part of the matrix */ +/* > V**T: */ +/* > = 'A': all N rows of V**T are returned in the array VT; */ - /* > = 'S': the first fla_min(m,n) rows of V**T (the right singular */ - /* > vectors) are returned in the array VT; +/* > = 'S': the first fla_min(m,n) rows of V**T (the right singular */ +/* > vectors) are returned in the array VT; */ - /* > = 'O': the first fla_min(m,n) rows of V**T (the right singular */ - /* > vectors) are overwritten on the array A; +/* > = 'O': the first fla_min(m,n) rows of V**T (the right singular */ +/* > vectors) are overwritten on the array A; */ - /* > = 'N': no rows of V**T (no right singular vectors) are */ - /* > computed. */ - /* > */ - /* > JOBVT and JOBU cannot both be 'O'. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] M */ - /* > \verbatim */ - /* > M is INTEGER */ - /* > The number of rows of the input matrix A. M >= 0. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] N */ - /* > \verbatim */ - /* > N is INTEGER */ - /* > The number of columns of the input matrix A. N >= 0. */ - /* > \endverbatim */ - /* > */ - /* > \param[in,out] A */ - /* > \verbatim */ - /* > A is DOUBLE PRECISION array, dimension (LDA,N) */ - /* > On entry, the M-by-N matrix A. */ - /* > On exit, */ - /* > if JOBU = 'O', A is overwritten with the first fla_min(m,n) */ - /* > columns of U (the left singular vectors, */ - /* > stored columnwise); +/* > = 'N': no rows of V**T (no right singular vectors) are */ +/* > computed. */ +/* > */ +/* > JOBVT and JOBU cannot both be 'O'. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] M */ +/* > \verbatim */ +/* > M is INTEGER */ +/* > The number of rows of the input matrix A. M >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] N */ +/* > \verbatim */ +/* > N is INTEGER */ +/* > The number of columns of the input matrix A. N >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] A */ +/* > \verbatim */ +/* > A is DOUBLE PRECISION array, dimension (LDA,N) */ +/* > On entry, the M-by-N matrix A. */ +/* > On exit, */ +/* > if JOBU = 'O', A is overwritten with the first fla_min(m,n) */ +/* > columns of U (the left singular vectors, */ +/* > stored columnwise); */ - /* > if JOBVT = 'O', A is overwritten with the first fla_min(m,n) */ - /* > rows of V**T (the right singular vectors, */ - /* > stored rowwise); +/* > if JOBVT = 'O', A is overwritten with the first fla_min(m,n) */ +/* > rows of V**T (the right singular vectors, */ +/* > stored rowwise); */ - /* > if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A */ - /* > are destroyed. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] LDA */ - /* > \verbatim */ - /* > LDA is INTEGER */ - /* > The leading dimension of the array A. LDA >= fla_max(1,M). */ - /* > \endverbatim */ - /* > */ - /* > \param[out] S */ - /* > \verbatim */ - /* > S is DOUBLE PRECISION array, dimension (fla_min(M,N)) */ - /* > The singular values of A, sorted so that S(i) >= S(i+1). */ - /* > \endverbatim */ - /* > */ - /* > \param[out] U */ - /* > \verbatim */ - /* > U is DOUBLE PRECISION array, dimension (LDU,UCOL) */ - /* > (LDU,M) if JOBU = 'A' or (LDU,fla_min(M,N)) if JOBU = 'S'. */ - /* > If JOBU = 'A', U contains the M-by-M orthogonal matrix U; +/* > if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A */ +/* > are destroyed. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDA */ +/* > \verbatim */ +/* > LDA is INTEGER */ +/* > The leading dimension of the array A. LDA >= fla_max(1,M). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] S */ +/* > \verbatim */ +/* > S is DOUBLE PRECISION array, dimension (fla_min(M,N)) */ +/* > The singular values of A, sorted so that S(i) >= S(i+1). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] U */ +/* > \verbatim */ +/* > U is DOUBLE PRECISION array, dimension (LDU,UCOL) */ +/* > (LDU,M) if JOBU = 'A' or (LDU,fla_min(M,N)) if JOBU = 'S'. */ +/* > If JOBU = 'A', U contains the M-by-M orthogonal matrix U; */ - /* > if JOBU = 'S', U contains the first fla_min(m,n) columns of U */ - /* > (the left singular vectors, stored columnwise); +/* > if JOBU = 'S', U contains the first fla_min(m,n) columns of U */ +/* > (the left singular vectors, stored columnwise); */ - /* > if JOBU = 'N' or 'O', U is not referenced. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] LDU */ - /* > \verbatim */ - /* > LDU is INTEGER */ - /* > The leading dimension of the array U. LDU >= 1; - if */ - /* > JOBU = 'S' or 'A', LDU >= M. */ - /* > \endverbatim */ - /* > */ - /* > \param[out] VT */ - /* > \verbatim */ - /* > VT is DOUBLE PRECISION array, dimension (LDVT,N) */ - /* > If JOBVT = 'A', VT contains the N-by-N orthogonal matrix */ - /* > V**T; +/* > if JOBU = 'N' or 'O', U is not referenced. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDU */ +/* > \verbatim */ +/* > LDU is INTEGER */ +/* > The leading dimension of the array U. LDU >= 1; +if */ +/* > JOBU = 'S' or 'A', LDU >= M. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] VT */ +/* > \verbatim */ +/* > VT is DOUBLE PRECISION array, dimension (LDVT,N) */ +/* > If JOBVT = 'A', VT contains the N-by-N orthogonal matrix */ +/* > V**T; */ - /* > if JOBVT = 'S', VT contains the first fla_min(m,n) rows of */ - /* > V**T (the right singular vectors, stored rowwise); +/* > if JOBVT = 'S', VT contains the first fla_min(m,n) rows of */ +/* > V**T (the right singular vectors, stored rowwise); */ - /* > if JOBVT = 'N' or 'O', VT is not referenced. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] LDVT */ - /* > \verbatim */ - /* > LDVT is INTEGER */ - /* > The leading dimension of the array VT. LDVT >= 1; - if */ - /* > JOBVT = 'A', LDVT >= N; - if JOBVT = 'S', LDVT >= fla_min(M,N). */ - /* > \endverbatim */ - /* > */ - /* > \param[out] WORK */ - /* > \verbatim */ - /* > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */ - /* > On exit, if INFO = 0, WORK(1) returns the optimal LWORK; +/* > if JOBVT = 'N' or 'O', VT is not referenced. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDVT */ +/* > \verbatim */ +/* > LDVT is INTEGER */ +/* > The leading dimension of the array VT. LDVT >= 1; +if */ +/* > JOBVT = 'A', LDVT >= N; +if JOBVT = 'S', LDVT >= fla_min(M,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] WORK */ +/* > \verbatim */ +/* > WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */ +/* > On exit, if INFO = 0, WORK(1) returns the optimal LWORK; */ - /* > if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged */ - /* > superdiagonal elements of an upper bidiagonal matrix B */ - /* > whose diagonal is in S (not necessarily sorted). B */ - /* > satisfies A = U * B * VT, so it has the same singular values */ - /* > as A, and singular vectors related by U and VT. */ - /* > \endverbatim */ - /* > */ - /* > \param[in] LWORK */ - /* > \verbatim */ - /* > LWORK is INTEGER */ - /* > The dimension of the array WORK. */ - /* > LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code): */ - /* > - PATH 1 (M much larger than N, JOBU='N') */ - /* > - PATH 1t (N much larger than M, JOBVT='N') */ - /* > LWORK >= MAX(1,3*MIN(M,N) + MAX(M,N),5*MIN(M,N)) for the other paths */ - /* > For good performance, LWORK should generally be larger. */ - /* > */ - /* > If LWORK = -1, then a workspace query is assumed; - the routine */ - /* > only calculates the optimal size of the WORK array, returns */ - /* > this value as the first entry of the WORK array, and no error */ - /* > message related to LWORK is issued by XERBLA. */ - /* > \endverbatim */ - /* > */ - /* > \param[out] INFO */ - /* > \verbatim */ - /* > INFO is INTEGER */ - /* > = 0: successful exit. */ - /* > < 0: if INFO = -i, the i-th argument had an illegal value. */ - /* > > 0: if lapack_dbdsqr did not converge, INFO specifies how many */ - /* > superdiagonals of an intermediate bidiagonal form B */ - /* > did not converge to zero. See the description of WORK */ - /* > above for details. */ - /* > \endverbatim */ - /* Authors: */ - /* ======== */ - /* > \author Univ. of Tennessee */ - /* > \author Univ. of California Berkeley */ - /* > \author Univ. of Colorado Denver */ - /* > \author NAG Ltd. */ - /* > \ingroup doubleGEsing */ - /* ===================================================================== */ - /* Subroutine */ - int lapack_dgesvd(char *jobu, char *jobvt, integer *m, integer *n, doublereal *a, integer *lda, doublereal *s, doublereal *u, integer * ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork, integer *info) { - /* System generated locals */ - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4; - char ch__1[2]; - /* Builtin functions */ - /* Subroutine */ - - double sqrt(doublereal); - /* Local variables */ - integer i__, ie, ir, iu, blk, ncu; - doublereal dum[1]; - integer nru, iscl; - doublereal anrm; - integer ierr, itau, ncvt, nrvt, lwork_dgebrd, lwork_dgelqf, lwork_dgeqrf; - - extern logical lsame_(char *, char *); - integer chunk, minmn, wrkbl, itaup, itauq, mnthr, iwork; - logical wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs; - extern /* Subroutine */ - int lapack_dgebrd(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); - extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); - integer bdspac; - extern /* Subroutine */ - int lapack_dgelqf(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), lapack_dbdsqr(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), lapack_dorgbr(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); - extern /* Subroutine */ - int xerbla_(char *, integer *); - extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); - extern /* Subroutine */ - int lapack_dormbr(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), lapack_dorglq(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), lapack_dorgqr(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); - integer ldwrkr, minwrk, ldwrku, maxwrk; - static doublereal bignum, smlnum, eps; - logical lquery, wntuas, wntvas; - integer lwork_dorgbrp, lwork_dorgbrq, lwork_dorglqm, lwork_dorglqn, lwork_dorgqrm, lwork_dorgqrn; - /* -- LAPACK driver routine -- */ - /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ - /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ - /* .. Scalar Arguments .. */ - /* .. */ - /* .. Array Arguments .. */ - /* .. */ - /* ===================================================================== */ - /* .. Parameters .. */ - /* .. */ - /* .. Local Scalars .. */ - /* .. */ - /* .. Local Arrays .. */ - /* .. */ - /* .. External Subroutines .. */ - /* .. */ - /* .. External Functions .. */ - /* .. */ - /* .. Intrinsic Functions .. */ - /* .. */ - /* .. Executable Statements .. */ - /* Test the input arguments */ - /* Parameter adjustments */ - a_dim1 = *lda; - a_offset = 1 + a_dim1; - a -= a_offset; - --s; - u_dim1 = *ldu; - u_offset = 1 + u_dim1; - u -= u_offset; - vt_dim1 = *ldvt; - vt_offset = 1 + vt_dim1; - vt -= vt_offset; - --work; - /* Function Body */ - *info = 0; - minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); - wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); - wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); - lquery = *lwork == -1; - if (! (wntua || wntus || wntuo || wntun)) { - *info = -1; - } - else if (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo) { - *info = -2; - } - else if (*m < 0) { - *info = -3; - } - else if (*n < 0) { - *info = -4; - } - else if (*lda < fla_max(1,*m)) { - *info = -6; - } - else if (*ldu < 1 || wntuas && *ldu < *m) { - *info = -9; - } - else if (*ldvt < 1 || wntva && *ldvt < *n || wntvs && *ldvt < minmn) { - *info = -11; - } - /* Compute workspace */ - /* (Note: Comments in the code beginning "Workspace:" describe the */ - /* minimal amount of workspace needed at that point in the code, */ - /* as well as the preferred amount for good performance. */ - /* NB refers to the optimal block size for the immediately */ - /* following subroutine, as returned by ILAENV.) */ -#ifdef FLA_ENABLE_AMD_OPT - if (*info == 0) - { +/* > if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged */ +/* > superdiagonal elements of an upper bidiagonal matrix B */ +/* > whose diagonal is in S (not necessarily sorted). B */ +/* > satisfies A = U * B * VT, so it has the same singular values */ +/* > as A, and singular vectors related by U and VT. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LWORK */ +/* > \verbatim */ +/* > LWORK is INTEGER */ +/* > The dimension of the array WORK. */ +/* > LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code): */ +/* > - PATH 1 (M much larger than N, JOBU='N') */ +/* > - PATH 1t (N much larger than M, JOBVT='N') */ +/* > LWORK >= MAX(1,3*MIN(M,N) + MAX(M,N),5*MIN(M,N)) for the other paths */ +/* > For good performance, LWORK should generally be larger. */ +/* > */ +/* > If LWORK = -1, then a workspace query is assumed; +the routine */ +/* > only calculates the optimal size of the WORK array, returns */ +/* > this value as the first entry of the WORK array, and no error */ +/* > message related to LWORK is issued by XERBLA. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] INFO */ +/* > \verbatim */ +/* > INFO is INTEGER */ +/* > = 0: successful exit. */ +/* > < 0: if INFO = -i, the i-th argument had an illegal value. */ +/* > > 0: if lapack_dbdsqr did not converge, INFO specifies how many */ +/* > superdiagonals of an intermediate bidiagonal form B */ +/* > did not converge to zero. See the description of WORK */ +/* > above for details. */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Univ. of Tennessee */ +/* > \author Univ. of California Berkeley */ +/* > \author Univ. of Colorado Denver */ +/* > \author NAG Ltd. */ +/* > \ingroup doubleGEsing */ +/* ===================================================================== */ +/* Subroutine */ +int lapack_dgesvd(char *jobu, char *jobvt, integer *m, integer *n, + doublereal *a, integer *lda, doublereal *s, doublereal *u, + integer *ldu, doublereal *vt, integer *ldvt, doublereal *work, + integer *lwork, integer *info) { + /* System generated locals */ + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, + i__4; + char ch__1[2]; + /* Builtin functions */ + /* Subroutine */ + + double sqrt(doublereal); + /* Local variables */ + integer i__, ie, ir, iu, blk, ncu; + doublereal dum[1]; + integer nru, iscl; + doublereal anrm; + integer ierr, itau, ncvt, nrvt, lwork_dgebrd, lwork_dgelqf, lwork_dgeqrf; + +#ifndef FLA_ENABLE_AOCL_BLAS + extern logical lsame_(char *, char *, integer a, integer b); +#endif + integer chunk, minmn, wrkbl, itaup, itauq, mnthr, iwork; + logical wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs; + extern /* Subroutine */ + int + lapack_dgebrd(integer *, integer *, doublereal *, integer *, doublereal *, + doublereal *, doublereal *, doublereal *, doublereal *, + integer *, integer *); + extern doublereal dlamch_(char *), + dlange_(char *, integer *, integer *, doublereal *, integer *, + doublereal *); + integer bdspac; + extern /* Subroutine */ + int + lapack_dgelqf(integer *, integer *, doublereal *, integer *, doublereal *, + doublereal *, integer *, integer *), + dlascl_(char *, integer *, integer *, doublereal *, doublereal *, + integer *, integer *, doublereal *, integer *, integer *), + dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, + doublereal *, integer *, integer *), + dlacpy_(char *, integer *, integer *, doublereal *, integer *, + doublereal *, integer *), + dlaset_(char *, integer *, integer *, doublereal *, doublereal *, + doublereal *, integer *), + lapack_dbdsqr(char *, integer *, integer *, integer *, integer *, + doublereal *, doublereal *, doublereal *, integer *, + doublereal *, integer *, doublereal *, integer *, + doublereal *, integer *), + lapack_dorgbr(char *, integer *, integer *, integer *, doublereal *, + integer *, doublereal *, doublereal *, integer *, + integer *); + extern /* Subroutine */ + int + xerbla_(const char *srname, const integer *info, ftnlen srname_len); + extern integer ilaenv_(integer *, char *, char *, integer *, integer *, + integer *, integer *); + extern /* Subroutine */ + int + lapack_dormbr(char *, char *, char *, integer *, integer *, integer *, + doublereal *, integer *, doublereal *, doublereal *, + integer *, doublereal *, integer *, integer *), + lapack_dorglq(integer *, integer *, integer *, doublereal *, integer *, + doublereal *, doublereal *, integer *, integer *), + lapack_dorgqr(integer *, integer *, integer *, doublereal *, integer *, + doublereal *, doublereal *, integer *, integer *); + integer ldwrkr, minwrk, ldwrku, maxwrk; + static doublereal bignum, smlnum, eps; + logical lquery, wntuas, wntvas; + integer lwork_dorgbrp, lwork_dorgbrq, lwork_dorglqm, lwork_dorglqn, + lwork_dorgqrm, lwork_dorgqrn; + /* -- LAPACK driver routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- + */ + /* .. Scalar Arguments .. */ + /* .. */ + /* .. Array Arguments .. */ + /* .. */ + /* ===================================================================== */ + /* .. Parameters .. */ + /* .. */ + /* .. Local Scalars .. */ + /* .. */ + /* .. Local Arrays .. */ + /* .. */ + /* .. External Subroutines .. */ + /* .. */ + /* .. External Functions .. */ + /* .. */ + /* .. Intrinsic Functions .. */ + /* .. */ + /* .. Executable Statements .. */ + /* Test the input arguments */ + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + --s; + u_dim1 = *ldu; + u_offset = 1 + u_dim1; + u -= u_offset; + vt_dim1 = *ldvt; + vt_offset = 1 + vt_dim1; + vt -= vt_offset; + --work; + /* Function Body */ + *info = 0; + minmn = fla_min(*m, *n); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); + wntuas = wntua || wntus; + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); + wntvas = wntva || wntvs; + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); + lquery = *lwork == -1; + ie = 0; + bdspac = 0; + mnthr = 0; + wrkbl = 0; + if (!(wntua || wntus || wntuo || wntun)) { + *info = -1; + } else if (!(wntva || wntvs || wntvo || wntvn) || wntvo && wntuo) { + *info = -2; + } else if (*m < 0) { + *info = -3; + } else if (*n < 0) { + *info = -4; + } else if (*lda < fla_max(1, *m)) { + *info = -6; + } else if (*ldu < 1 || wntuas && *ldu < *m) { + *info = -9; + } else if (*ldvt < 1 || wntva && *ldvt < *n || wntvs && *ldvt < minmn) { + *info = -11; + } + /* Compute workspace */ + /* (Note: Comments in the code beginning "Workspace:" describe the */ + /* minimal amount of workspace needed at that point in the code, */ + /* as well as the preferred amount for good performance. */ + /* NB refers to the optimal block size for the immediately */ + /* following subroutine, as returned by ILAENV.) */ +#if FLA_ENABLE_AMD_OPT + if (*info == 0) { minwrk = 1; maxwrk = 1; - if (*m >= *n && minmn > 0) - { - /* Compute space needed for lapack_dbdsqr */ - mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); - bdspac = *n * 5; - if (*m >= mnthr) - { - /* Compute space needed for DGEQRF */ - lwork_dgeqrf = *n * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DGEBRD */ - lwork_dgebrd = *n * 2 * FLA_GEQRF_BLOCK_SIZE; - if (wntun) { - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 1 (M much larger than N, JOBU='N') */ - maxwrk = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - maxwrk = fla_max(i__2,i__3); - if (wntvo || wntvas) { - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *n << 2; - minwrk = fla_max(i__2,bdspac); - } - else if (wntuo && wntvn) { - /* Compute space needed for DORGQR */ - lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *n * *n + wrkbl; i__3 = *n * *n + *m * *n + *n; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntuo && wntvas) { - /* Compute space needed for DORGQR */ - lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *n * *n + wrkbl; i__3 = *n * *n + *m * *n + *n; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntus && wntvn) { - /* Compute space needed for DORGQR */ - lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntus && wntvo) { - /* Compute space needed for DORGQR */ - lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*n << 1) * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntus && wntvas) { - /* Compute space needed for DORGQR */ - lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntua && wntvn) { - /* Compute space needed for DORGQR */ - lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntua && wntvo) { - /* Compute space needed for DORGQR */ - lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*n << 1) * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - else if (wntua && wntvas) { - /* Compute space needed for DORGQR */ - lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - } - else - { - /* Path 10 (M at least N, but not much larger) */ - lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; - maxwrk = *n * 3 + lwork_dgebrd; - if (wntus || wntuo) { - lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - if (wntua) { - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - if (! wntvn) { - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); + if (*m >= *n && minmn > 0) { + /* Compute space needed for lapack_dbdsqr */ + mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); + bdspac = *n * 5; + if (*m >= mnthr) { + /* Compute space needed for DGEQRF */ + lwork_dgeqrf = *n * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DGEBRD */ + lwork_dgebrd = *n * 2 * FLA_GEQRF_BLOCK_SIZE; + if (wntun) { + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 1 (M much larger than N, JOBU='N') */ + maxwrk = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + maxwrk = fla_max(i__2, i__3); + if (wntvo || wntvas) { /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *n << 2; + minwrk = fla_max(i__2, bdspac); + } else if (wntuo && wntvn) { + /* Compute space needed for DORGQR */ + lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *n * *n + wrkbl; + i__3 = *n * *n + *m * *n + *n; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntuo && wntvas) { + /* Compute space needed for DORGQR */ + lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *n * *n + wrkbl; + i__3 = *n * *n + *m * *n + *n; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvn) { + /* Compute space needed for DORGQR */ + lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvo) { + /* Compute space needed for DORGQR */ + lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*n << 1) * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvas) { + /* Compute space needed for DORGQR */ + lwork_dorgqrn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvn) { + /* Compute space needed for DORGQR */ + lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvo) { + /* Compute space needed for DORGQR */ + lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*n << 1) * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvas) { + /* Compute space needed for DORGQR */ + lwork_dorgqrm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); } - } - else if (minmn > 0) - { - /* Compute space needed for lapack_dbdsqr */ - mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); - bdspac = *m * 5; - if (*n >= mnthr) { - /* Compute space needed for DGELQF */ - lwork_dgelqf = *m * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DGEBRD */ - lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; - if (wntvn) { - /* Path 1t(N much larger than M, JOBVT='N') */ - maxwrk = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - maxwrk = fla_max(i__2,i__3); - if (wntuo || wntuas) { - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *m << 2; - minwrk = fla_max(i__2,bdspac); - } - else if (wntvo && wntun) { - /* Compute space needed for DORGLQ */ - lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *m * *m + wrkbl; i__3 = *m * *m + *m * *n + *m; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntvo && wntuas) { - /* Compute space needed for DORGLQ */ - lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Path 3t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='O') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *m * *m + wrkbl; i__3 = *m * *m + *m * *n + *m; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntvs && wntun) { - lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntvs && wntuo) { - /* Compute space needed for DORGLQ */ - lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*m << 1) * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntvs && wntuas) { - /* Compute space needed for DORGLQ */ - lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Path 6t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntva && wntun) { - lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntva && wntuo) { - lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*m << 1) * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } - else if (wntva && wntuas) { - /* Compute space needed for DORGLQ */ - lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Path 9t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); - } + } else { + /* Path 10 (M at least N, but not much larger) */ + lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; + maxwrk = *n * 3 + lwork_dgebrd; + if (wntus || wntuo) { + lwork_dorgbrq = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); } - else { - /* Path 10t(N greater than M, but not much larger) */ - lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; - maxwrk = *m * 3 + lwork_dgebrd; - if (wntvs || wntvo) { - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - if (wntva) { - /* Compute space needed for DORGBR P */ - lwork_dorgbrp = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - if (! wntun) { - /* Compute space needed for DORGBR Q */ - lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); + if (wntua) { + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (!wntvn) { + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } + } else if (minmn > 0) { + /* Compute space needed for lapack_dbdsqr */ + mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); + bdspac = *m * 5; + if (*n >= mnthr) { + /* Compute space needed for DGELQF */ + lwork_dgelqf = *m * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DGEBRD */ + lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; + if (wntvn) { + /* Path 1t(N much larger than M, JOBVT='N') */ + maxwrk = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + maxwrk = fla_max(i__2, i__3); + if (wntuo || wntuas) { + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *m << 2; + minwrk = fla_max(i__2, bdspac); + } else if (wntvo && wntun) { + /* Compute space needed for DORGLQ */ + lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *m * *m + wrkbl; + i__3 = *m * *m + *m * *n + *m; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvo && wntuas) { + /* Compute space needed for DORGLQ */ + lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Path 3t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='O') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *m * *m + wrkbl; + i__3 = *m * *m + *m * *n + *m; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntun) { + lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntuo) { + /* Compute space needed for DORGLQ */ + lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*m << 1) * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntuas) { + /* Compute space needed for DORGLQ */ + lwork_dorglqm = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Path 6t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntun) { + lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntuo) { + lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*m << 1) * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntuas) { + /* Compute space needed for DORGLQ */ + lwork_dorglqn = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*m - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Path 9t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } + } else { + /* Path 10t(N greater than M, but not much larger) */ + lwork_dgebrd = (*m + *n) * FLA_GEQRF_BLOCK_SIZE; + maxwrk = *m * 3 + lwork_dgebrd; + if (wntvs || wntvo) { + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, (*n - 1)) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); } + if (wntva) { + /* Compute space needed for DORGBR P */ + lwork_dorgbrp = fla_max(1, *n) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (!wntun) { + /* Compute space needed for DORGBR Q */ + lwork_dorgbrq = fla_max(1, *m) * FLA_GEQRF_BLOCK_SIZE; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } } - maxwrk = fla_max(maxwrk,minwrk); - work[1] = (doublereal) maxwrk; - if (*lwork < minwrk && ! lquery) { - *info = -13; + maxwrk = fla_max(maxwrk, minwrk); + work[1] = (doublereal)maxwrk; + if (*lwork < minwrk && !lquery) { + *info = -13; } - } + } #else - if (*info == 0) - { + if (*info == 0) { minwrk = 1; maxwrk = 1; - if (*m >= *n && minmn > 0) - { - /* Compute space needed for lapack_dbdsqr */ - mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); - bdspac = *n * 5; - if (*m >= mnthr) - { - dgeqrf_(m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dgeqrf = (integer) dum[0]; - /* Compute space needed for DORGQR */ - lapack_dorgqr(m, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgqrn = (integer) dum[0]; - lapack_dorgqr(m, m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgqrm = (integer) dum[0]; - /* Compute space needed for DGEBRD */ - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, &ierr); - lwork_dgebrd = (integer) dum[0]; - /* Compute space needed for DORGBR P */ - lapack_dorgbr("P", n, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgbrp = (integer) dum[0]; - /* Compute space needed for DORGBR Q */ - lapack_dorgbr("Q", n, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgbrq = (integer) dum[0]; - if (wntun) { - /* Path 1 (M much larger than N, JOBU='N') */ - maxwrk = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - maxwrk = fla_max(i__2,i__3); - if (wntvo || wntvas) { - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *n << 2; - minwrk = fla_max(i__2,bdspac); + if (*m >= *n && minmn > 0) { + /* Compute space needed for lapack_dbdsqr */ + mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); + bdspac = *n * 5; + if (*m >= mnthr) { + dgeqrf_(m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dgeqrf = (integer)dum[0]; + /* Compute space needed for DORGQR */ + lapack_dorgqr(m, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dorgqrn = (integer)dum[0]; + lapack_dorgqr(m, m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dorgqrm = (integer)dum[0]; + /* Compute space needed for DGEBRD */ + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, + &ierr); + lwork_dgebrd = (integer)dum[0]; + /* Compute space needed for DORGBR P */ + lapack_dorgbr("P", n, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dorgbrp = (integer)dum[0]; + /* Compute space needed for DORGBR Q */ + lapack_dorgbr("Q", n, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dorgbrq = (integer)dum[0]; + if (wntun) { + /* Path 1 (M much larger than N, JOBU='N') */ + maxwrk = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + maxwrk = fla_max(i__2, i__3); + if (wntvo || wntvas) { + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *n << 2; + minwrk = fla_max(i__2, bdspac); + } else if (wntuo && wntvn) { + /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *n * *n + wrkbl; + i__3 = *n * *n + *m * *n + *n; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntuo && wntvas) { + /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *n * *n + wrkbl; + i__3 = *n * *n + *m * *n + *n; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvn) { + /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvo) { + /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*n << 1) * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntus && wntvas) { + /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvn) { + /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvo) { + /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*n << 1) * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } else if (wntua && wntvas) { + /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */ + /* 'A') */ + wrkbl = *n + lwork_dgeqrf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n + lwork_dorgqrm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *n * *n + wrkbl; + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } + } else { + /* Path 10 (M at least N, but not much larger) */ + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, + &ierr); + lwork_dgebrd = (integer)dum[0]; + maxwrk = *n * 3 + lwork_dgebrd; + if (wntus || wntuo) { + lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, dum, dum, &c_n1, + &ierr); + lwork_dorgbrq = (integer)dum[0]; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (wntua) { + /* Compute space needed for DORGBR Q */ + lapack_dorgbr("Q", m, m, n, &a[a_offset], lda, dum, dum, &c_n1, + &ierr); + lwork_dorgbrq = (integer)dum[0]; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (!wntvn) { + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *n * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *n * 3 + *m; + minwrk = fla_max(i__2, bdspac); + } + } else if (minmn > 0) { + /* Compute space needed for lapack_dbdsqr */ + mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); + bdspac = *m * 5; + /* Compute space needed for DGELQF */ + lapack_dgelqf(m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dgelqf = (integer)dum[0]; + /* Compute space needed for DORGLQ */ + lapack_dorglq(n, n, m, dum, n, dum, dum, &c_n1, &ierr); + lwork_dorglqn = (integer)dum[0]; + lapack_dorglq(m, n, m, &a[a_offset], lda, dum, dum, &c_n1, &ierr); + lwork_dorglqm = (integer)dum[0]; + /* Compute space needed for DGEBRD */ + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, + &ierr); + lwork_dgebrd = (integer)dum[0]; + /* Compute space needed for DORGBR P */ + lapack_dorgbr("P", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); + lwork_dorgbrp = (integer)dum[0]; + /* Compute space needed for DORGBR Q */ + lapack_dorgbr("Q", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); + lwork_dorgbrq = (integer)dum[0]; + if (*n >= mnthr) { + if (wntvn) { + /* Path 1t(N much larger than M, JOBVT='N') */ + maxwrk = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + maxwrk = fla_max(i__2, i__3); + if (wntuo || wntuas) { + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *m << 2; + minwrk = fla_max(i__2, bdspac); + } else if (wntvo && wntun) { + /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *m * *m + wrkbl; + i__3 = *m * *m + *m * *n + *m; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvo && wntuas) { + /* Path 3t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='O') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + /* Computing MAX */ + i__2 = *m * *m + wrkbl; + i__3 = *m * *m + *m * *n + *m; // , expr subst + maxwrk = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntun) { + /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntuo) { + /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*m << 1) * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntvs && wntuas) { + /* Path 6t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='S') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqm; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntun) { + /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntuo) { + /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = (*m << 1) * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } else if (wntva && wntuas) { + /* Path 9t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='A') */ + wrkbl = *m + lwork_dgelqf; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m + lwork_dorglqn; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dgebrd; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + wrkbl = fla_max(i__2, i__3); + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + wrkbl = fla_max(i__2, i__3); + wrkbl = fla_max(wrkbl, bdspac); + maxwrk = *m * *m + wrkbl; + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } + } else { + /* Path 10t(N greater than M, but not much larger) */ + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, + &ierr); + lwork_dgebrd = (integer)dum[0]; + maxwrk = *m * 3 + lwork_dgebrd; + if (wntvs || wntvo) { + /* Compute space needed for DORGBR P */ + lapack_dorgbr("P", m, n, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); + lwork_dorgbrp = (integer)dum[0]; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (wntva) { + lapack_dorgbr("P", n, n, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); + lwork_dorgbrp = (integer)dum[0]; + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrp; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + if (!wntun) { + /* Computing MAX */ + i__2 = maxwrk; + i__3 = *m * 3 + lwork_dorgbrq; // , expr subst + maxwrk = fla_max(i__2, i__3); + } + maxwrk = fla_max(maxwrk, bdspac); + /* Computing MAX */ + i__2 = *m * 3 + *n; + minwrk = fla_max(i__2, bdspac); + } + } + maxwrk = fla_max(maxwrk, minwrk); + work[1] = (doublereal)maxwrk; + if (*lwork < minwrk && !lquery) { + *info = -13; + } + } +#endif + if (*info != 0) { + i__2 = -(*info); + xerbla_("DGESVD", &i__2, (ftnlen)6); + return 0; + } else if (lquery) { + return 0; + } + /* Quick return if possible */ + if (*m == 0 || *n == 0) { + return 0; + } + /* Get machine constants */ + static int r_once = 1; + + if (r_once) /* TODO: Remove with Global context */ + { + eps = dlamch_("P"); + smlnum = sqrt(dlamch_("S")) / eps; + bignum = 1. / smlnum; + r_once = 0; + } + /* Scale A if max element outside range [SMLNUM,BIGNUM] */ + anrm = dlange_("M", m, n, &a[a_offset], lda, dum); + iscl = 0; + if (anrm > 0. && anrm < smlnum) { + iscl = 1; + dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &ierr); + } else if (anrm > bignum) { + iscl = 1; + dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &ierr); + } + if (*m >= *n) { + /* A has at least as many rows as columns. If A has sufficiently */ + /* more rows than columns, first reduce using the QR */ + /* decomposition (if sufficient workspace available) */ + if (*m >= mnthr) { + if (wntun) { + /* Path 1 (M much larger than N, JOBU='N') */ + /* No left singular vectors to be computed */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Zero out below R */ + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); + } + ie = 1; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in A */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__2, &ierr); + ncvt = 0; + if (wntvo || wntvas) { + /* If right singular vectors desired, generate P'. */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__2, &ierr); + ncvt = *n; + } + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of A in A if desired */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &ncvt, &c__0, &c__0, &s[1], &work[ie], + &a[a_offset], lda, dum, &c__1, dum, &c__1, &work[iwork], + info); + /* If right singular vectors desired in VT, copy them there */ + if (wntvas) { + dlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + } + } else if (wntuo && wntvn) { + /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ + /* N left singular vectors to be overwritten on A and */ + /* no right singular vectors to be computed */ + /* Computing MAX */ + i__2 = *n << 2; + if (*lwork >= *n * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *lda * *n + *n; // , expr subst + if (*lwork >= fla_max(i__2, i__3) + *lda * *n) { + /* WORK(IU) is LDA by N, WORK(IR) is LDA by N */ + ldwrku = *lda; + ldwrkr = *lda; + } else /* if(complicated condition) */ + { + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *lda * *n + *n; // , expr subst + if (*lwork >= fla_max(i__2, i__3) + *n * *n) { + /* WORK(IU) is LDA by N, WORK(IR) is N by N */ + ldwrku = *lda; + ldwrkr = *n; + } else { + /* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */ + ldwrku = (*lwork - *n * *n - *n) / *n; + ldwrkr = *n; } - else if (wntuo && wntvn) { - /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *n * *n + wrkbl; i__3 = *n * *n + *m * *n + *n; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + } + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Copy R to WORK(IR) and zero out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); + /* Generate Q in A */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, &ierr); + /* Generate left vectors bidiagonalizing R */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IR) */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, + &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); + iu = ie + *n; + /* Multiply Q in A by left singular vectors of R in */ + /* WORK(IR), storing result in WORK(IU) and copying to A */ + /* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) */ + i__2 = *m; + i__3 = ldwrku; + for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) { + /* Computing MIN */ + i__4 = *m - i__ + 1; + chunk = fla_min(i__4, ldwrku); + dgemm_("N", "N", &chunk, n, n, &c_b79, &a[i__ + a_dim1], lda, + &work[ir], &ldwrkr, &c_b57, &work[iu], &ldwrku); + dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + a_dim1], lda); + /* L10: */ + } + } else { + /* Insufficient workspace for a fast algorithm */ + ie = 1; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize A */ + /* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__3, &ierr); + /* Generate left vectors bidiagonalizing A */ + /* (Workspace: need 4*N, prefer 3*N + N*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__3, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, + &a[a_offset], lda, dum, &c__1, &work[iwork], info); + } + } else if (wntuo && wntvas) { + /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A') */ + /* N left singular vectors to be overwritten on A and */ + /* N right singular vectors to be computed in VT */ + /* Computing MAX */ + i__3 = *n << 2; + if (*lwork >= *n * *n + fla_max(i__3, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + /* Computing MAX */ + i__3 = wrkbl; + i__2 = *lda * *n + *n; // , expr subst + if (*lwork >= fla_max(i__3, i__2) + *lda * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ + ldwrku = *lda; + ldwrkr = *lda; + } else /* if(complicated condition) */ + { + /* Computing MAX */ + i__3 = wrkbl; + i__2 = *lda * *n + *n; // , expr subst + if (*lwork >= fla_max(i__3, i__2) + *n * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is N by N */ + ldwrku = *lda; + ldwrkr = *n; + } else { + /* WORK(IU) is LDWRKU by N and WORK(IR) is N by N */ + ldwrku = (*lwork - *n * *n - *n) / *n; + ldwrkr = *n; } - else if (wntuo && wntvas) { - /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *n * *n + wrkbl; i__3 = *n * *n + *m * *n + *n; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + } + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__3 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__3, + &ierr); + /* Copy R to VT, zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + if (*n > 1) { + i__3 = *n - 1; + i__2 = *n - 1; + dlaset_("L", &i__3, &i__2, &c_b57, &c_b57, &vt[vt_dim1 + 2], ldvt); + } + /* Generate Q in A */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__3, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in VT, copying result to WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__3, &ierr); + dlacpy_("L", n, n, &vt[vt_offset], ldvt, &work[ir], &ldwrkr); + /* Generate left vectors bidiagonalizing R in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__3, &ierr); + /* Generate right vectors bidiagonalizing R in VT */ + /* (Workspace: need N*N + 4*N-1, prefer N*N + 3*N + (N-1)*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__3, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IR) and computing right */ + /* singular vectors of R in VT */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], + info); + iu = ie + *n; + /* Multiply Q in A by left singular vectors of R in */ + /* WORK(IR), storing result in WORK(IU) and copying to A */ + /* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) */ + i__3 = *m; + i__2 = ldwrku; + for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ += i__2) { + /* Computing MIN */ + i__4 = *m - i__ + 1; + chunk = fla_min(i__4, ldwrku); + dgemm_("N", "N", &chunk, n, n, &c_b79, &a[i__ + a_dim1], lda, + &work[ir], &ldwrkr, &c_b57, &work[iu], &ldwrku); + dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + a_dim1], lda); + /* L20: */ + } + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Copy R to VT, zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[vt_dim1 + 2], ldvt); + } + /* Generate Q in A */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in VT */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, &ierr); + /* Multiply Q in A by left vectors bidiagonalizing R */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, + &work[itauq], &a[a_offset], lda, &work[iwork], &i__2, + &ierr); + /* Generate right vectors bidiagonalizing R in VT */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in A and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &a[a_offset], lda, dum, &c__1, &work[iwork], + info); + } + } else if (wntus) { + if (wntvn) { + /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ + /* N left singular vectors to be computed in U and */ + /* no right singular vectors to be computed */ + /* Computing MAX */ + i__2 = *n << 2; + if (*lwork >= *n * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + if (*lwork >= wrkbl + *lda * *n) { + /* WORK(IR) is LDA by N */ + ldwrkr = *lda; + } else { + /* WORK(IR) is N by N */ + ldwrkr = *n; } - else if (wntus && wntvn) { - /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Copy R to WORK(IR), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); + /* Generate Q in A */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Generate left vectors bidiagonalizing R in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IR) */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, + &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); + /* Multiply Q in A by left singular vectors of R in */ + /* WORK(IR), storing result in U */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, &work[ir], + &ldwrkr, &c_b57, &u[u_offset], ldu); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Zero out below R in A */ + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); } - else if (wntus && wntvo) { - /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*n << 1) * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + /* Bidiagonalize R in A */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left vectors bidiagonalizing R */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, + &u[u_offset], ldu, dum, &c__1, &work[iwork], info); + } + } else if (wntvo) { + /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ + /* N left singular vectors to be computed in U and */ + /* N right singular vectors to be overwritten on A */ + /* Computing MAX */ + i__2 = *n << 2; + if (*lwork >= (*n << 1) * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + (*lda << 1) * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ + ldwrku = *lda; + ir = iu + ldwrku * *n; + ldwrkr = *lda; + } else if (*lwork >= wrkbl + (*lda + *n) * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is N by N */ + ldwrku = *lda; + ir = iu + ldwrku * *n; + ldwrkr = *n; + } else { + /* WORK(IU) is N by N and WORK(IR) is N by N */ + ldwrku = *n; + ir = iu + ldwrku * *n; + ldwrkr = *n; } - else if (wntus && wntvas) { - /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Copy R to WORK(IU), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); + /* Generate Q in A */ + /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IU), copying result to */ + /* WORK(IR) */ + /* (Workspace: need 2*N*N + 4*N, */ + /* prefer 2*N*N+3*N+2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &ldwrkr); + /* Generate left bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], + &work[iwork], &i__2, &ierr); + /* Generate right bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need 2*N*N + 4*N-1, */ + /* prefer 2*N*N+3*N+(N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IU) and computing */ + /* right singular vectors of R in WORK(IR) */ + /* (Workspace: need 2*N*N + BDSPAC) */ + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, &work[iu], &ldwrku, dum, &c__1, &work[iwork], + info); + /* Multiply Q in A by left singular vectors of R in */ + /* WORK(IU), storing result in U */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, &work[iu], + &ldwrku, &c_b57, &u[u_offset], ldu); + /* Copy right singular vectors of R to A */ + /* (Workspace: need N*N) */ + dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Zero out below R in A */ + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); } - else if (wntua && wntvn) { - /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + /* Bidiagonalize R in A */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left vectors bidiagonalizing R */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + /* Generate right vectors bidiagonalizing R in A */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[a_offset], + lda, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } + } else if (wntvas) { + /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' */ + /* or 'A') */ + /* N left singular vectors to be computed in U and */ + /* N right singular vectors to be computed in VT */ + /* Computing MAX */ + i__2 = *n << 2; + if (*lwork >= *n * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + *lda * *n) { + /* WORK(IU) is LDA by N */ + ldwrku = *lda; + } else { + /* WORK(IU) is N by N */ + ldwrku = *n; } - else if (wntua && wntvo) { - /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*n << 1) * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + itau = iu + ldwrku * *n; + iwork = itau + *n; + /* Compute A=Q*R */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Copy R to WORK(IU), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); +#if FLA_ENABLE_AMD_OPT + if (*n < 128 && global_context.is_avx2) { + fla_dgesvd_small6(m, n, &work[iu], &ldwrku, &a[a_offset], lda, + &s[1], &u[u_offset], ldu, &vt[vt_offset], ldvt, + &work[1], info); + } else +#endif + { + /* Generate Q in A */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IU), copying result to VT */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt); + /* Generate left bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], + &work[iwork], &i__2, &ierr); + /* Generate right bidiagonalizing vectors in VT */ + /* (Workspace: need N*N + 4*N-1, */ + /* prefer N*N+3*N+(N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IU) and computing */ + /* right singular vectors of R in VT */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, &work[iu], &ldwrku, dum, + &c__1, &work[iwork], info); + /* Multiply Q in A by left singular vectors of R in */ + /* WORK(IU), storing result in U */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, &work[iu], + &ldwrku, &c_b57, &u[u_offset], ldu); } - else if (wntua && wntvas) { - /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */ - /* 'A') */ - wrkbl = *n + lwork_dgeqrf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n + lwork_dorgqrm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *n * *n + wrkbl; - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy R to VT, zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[vt_dim1 + 2], + ldvt); } + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in VT */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left bidiagonalizing vectors */ + /* in VT */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + /* Generate right bidiagonalizing vectors in VT */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } } - else - { - /* Path 10 (M at least N, but not much larger) */ - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, & c_n1, &ierr); - lwork_dgebrd = (integer) dum[0]; - maxwrk = *n * 3 + lwork_dgebrd; - if (wntus || wntuo) { - lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgbrq = (integer) dum[0]; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); + } else if (wntua) { + if (wntvn) { + /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ + /* M left singular vectors to be computed in U and */ + /* no right singular vectors to be computed */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *n << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= *n * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + if (*lwork >= wrkbl + *lda * *n) { + /* WORK(IR) is LDA by N */ + ldwrkr = *lda; + } else { + /* WORK(IR) is N by N */ + ldwrkr = *n; } - if (wntua) { - /* Compute space needed for DORGBR Q */ - lapack_dorgbr("Q", m, m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorgbrq = (integer) dum[0]; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Copy R to WORK(IR), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); + /* Generate Q in U */ + /* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Generate left bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IR) */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, + &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); + /* Multiply Q in U by left singular vectors of R in */ + /* WORK(IR), storing result in A */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, &work[ir], + &ldwrkr, &c_b57, &a[a_offset], lda); + /* Copy left singular vectors of A from A to U */ + dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need N + M, prefer N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Zero out below R in A */ + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); } - if (! wntvn) { - /* Computing MAX */ - i__2 = maxwrk; i__3 = *n * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); + /* Bidiagonalize R in A */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left bidiagonalizing vectors */ + /* in A */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, + &u[u_offset], ldu, dum, &c__1, &work[iwork], info); + } + } else if (wntvo) { + /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ + /* M left singular vectors to be computed in U and */ + /* N right singular vectors to be overwritten on A */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *n << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= (*n << 1) * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + (*lda << 1) * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ + ldwrku = *lda; + ir = iu + ldwrku * *n; + ldwrkr = *lda; + } else if (*lwork >= wrkbl + (*lda + *n) * *n) { + /* WORK(IU) is LDA by N and WORK(IR) is N by N */ + ldwrku = *lda; + ir = iu + ldwrku * *n; + ldwrkr = *n; + } else { + /* WORK(IU) is N by N and WORK(IR) is N by N */ + ldwrku = *n; + ir = iu + ldwrku * *n; + ldwrkr = *n; } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *n * 3 + *m; - minwrk = fla_max(i__2,bdspac); - } - } - else if (minmn > 0) - { - /* Compute space needed for lapack_dbdsqr */ - mnthr = ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0); - bdspac = *m * 5; - /* Compute space needed for DGELQF */ - lapack_dgelqf(m, n, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dgelqf = (integer) dum[0]; - /* Compute space needed for DORGLQ */ - lapack_dorglq(n, n, m, dum, n, dum, dum, &c_n1, &ierr); - lwork_dorglqn = (integer) dum[0]; - lapack_dorglq(m, n, m, &a[a_offset], lda, dum, dum, &c_n1, &ierr); - lwork_dorglqm = (integer) dum[0]; - /* Compute space needed for DGEBRD */ - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], dum, dum, dum, dum, &c_n1, &ierr); - lwork_dgebrd = (integer) dum[0]; - /* Compute space needed for DORGBR P */ - lapack_dorgbr("P", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); - lwork_dorgbrp = (integer) dum[0]; - /* Compute space needed for DORGBR Q */ - lapack_dorgbr("Q", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); - lwork_dorgbrq = (integer) dum[0]; - if (*n >= mnthr) { - if (wntvn) { - /* Path 1t(N much larger than M, JOBVT='N') */ - maxwrk = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - maxwrk = fla_max(i__2,i__3); - if (wntuo || wntuas) { - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); - } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *m << 2; - minwrk = fla_max(i__2,bdspac); + itau = ir + ldwrkr * *n; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need 2*N*N + N + M, prefer 2*N*N + N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy R to WORK(IU), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IU), copying result to */ + /* WORK(IR) */ + /* (Workspace: need 2*N*N + 4*N, */ + /* prefer 2*N*N+3*N+2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &ldwrkr); + /* Generate left bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], + &work[iwork], &i__2, &ierr); + /* Generate right bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need 2*N*N + 4*N-1, */ + /* prefer 2*N*N+3*N+(N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IU) and computing */ + /* right singular vectors of R in WORK(IR) */ + /* (Workspace: need 2*N*N + BDSPAC) */ + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, &work[iu], &ldwrku, dum, &c__1, &work[iwork], + info); + /* Multiply Q in U by left singular vectors of R in */ + /* WORK(IU), storing result in A */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, &work[iu], + &ldwrku, &c_b57, &a[a_offset], lda); + /* Copy left singular vectors of A from A to U */ + dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Copy right singular vectors of R from WORK(IR) to A */ + dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need N + M, prefer N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Zero out below R in A */ + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); } - else if (wntvo && wntun) { - /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *m * *m + wrkbl; i__3 = *m * *m + *m * *n + *m; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + /* Bidiagonalize R in A */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left bidiagonalizing vectors */ + /* in A */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + /* Generate right bidiagonalizing vectors in A */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[a_offset], + lda, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } + } else if (wntvas) { + /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' */ + /* or 'A') */ + /* M left singular vectors to be computed in U and */ + /* N right singular vectors to be computed in VT */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *n << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= *n * *n + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + *lda * *n) { + /* WORK(IU) is LDA by N */ + ldwrku = *lda; + } else { + /* WORK(IU) is N by N */ + ldwrku = *n; } - else if (wntvo && wntuas) { - /* Path 3t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='O') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - /* Computing MAX */ - i__2 = *m * *m + wrkbl; i__3 = *m * *m + *m * *n + *m; // , expr subst - maxwrk = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + itau = iu + ldwrku * *n; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy R to WORK(IU), zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in WORK(IU), copying result to VT */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt); + /* Generate left bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], + &work[iwork], &i__2, &ierr); + /* Generate right bidiagonalizing vectors in VT */ + /* (Workspace: need N*N + 4*N-1, */ + /* prefer N*N+3*N+(N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of R in WORK(IU) and computing */ + /* right singular vectors of R in VT */ + /* (Workspace: need N*N + BDSPAC) */ + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &work[iu], &ldwrku, dum, &c__1, &work[iwork], + info); + /* Multiply Q in U by left singular vectors of R in */ + /* WORK(IU), storing result in A */ + /* (Workspace: need N*N) */ + dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, &work[iu], + &ldwrku, &c_b57, &a[a_offset], lda); + /* Copy left singular vectors of A from A to U */ + dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *n; + /* Compute A=Q*R, copying result to U */ + /* (Workspace: need 2*N, prefer N + N*NB) */ + i__2 = *lwork - iwork + 1; + dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + /* Generate Q in U */ + /* (Workspace: need N + M, prefer N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy R from A to VT, zeroing out below it */ + dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + if (*n > 1) { + i__2 = *n - 1; + i__3 = *n - 1; + dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[vt_dim1 + 2], + ldvt); } - else if (wntvs && wntun) { - /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + ie = itau; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize R in VT */ + /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply Q in U by left bidiagonalizing vectors */ + /* in VT */ + /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, + &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, + &ierr); + /* Generate right bidiagonalizing vectors in VT */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *n; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } + } + } + } else { + /* M .LT. MNTHR */ + /* Path 10 (M at least N, but not much larger) */ + /* Reduce to bidiagonal form without QR decomposition */ +#if FLA_ENABLE_AMD_OPT + if ((wntun & wntvn) && (*m < 128) && global_context.is_avx2) { + fla_dgesvd_nn_small10(m, n, &a[a_offset], lda, &s[1], &work[1], info); + } else +#endif + { + ie = 1; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + /* Bidiagonalize A */ + /* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__2, &ierr); + if (wntuas) { + /* If left singular vectors desired in U, copy result to U */ + /* and generate left bidiagonalizing vectors in U */ + /* (Workspace: need 3*N + NCU, prefer 3*N + NCU*NB) */ + dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); + if (wntus) { + ncu = *n; + } + if (wntua) { + ncu = *m; + } + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + } + if (wntvas) { + /* If right singular vectors desired in VT, copy result to */ + /* VT and generate right bidiagonalizing vectors in VT */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + } + if (wntuo) { + /* If left singular vectors desired in A, generate left */ + /* bidiagonalizing vectors in A */ + /* (Workspace: need 4*N, prefer 3*N + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__2, &ierr); + } + if (wntvo) { + /* If right singular vectors desired in A, generate right */ + /* bidiagonalizing vectors in A */ + /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__2, &ierr); + } + iwork = ie + *n; + if (wntuas || wntuo) { + nru = *m; + } + if (wntun) { + nru = 0; + } + if (wntvas || wntvo) { + ncvt = *n; + } + if (wntvn) { + ncvt = 0; + } + if (!wntuo && !wntvo) { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in U and computing right singular */ + /* vectors in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, + &work[iwork], info); + } else if (!wntuo && wntvo) { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in U and computing right singular */ + /* vectors in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], + &a[a_offset], lda, &u[u_offset], ldu, dum, &c__1, + &work[iwork], info); + } else { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in A and computing right singular */ + /* vectors in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, + &work[iwork], info); + } + } + } + } else { + /* A has more columns than rows. If A has sufficiently more */ + /* columns than rows, first reduce using the LQ decomposition (if */ + /* sufficient workspace available) */ + if (*n >= mnthr) { + if (wntvn) { + /* Path 1t(N much larger than M, JOBVT='N') */ + /* No right singular vectors to be computed */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, + &ierr); + /* Zero out above L */ + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); +#if FLA_ENABLE_AMD_OPT + if ((wntun && wntvn) && (*m < 128) && global_context.is_avx2) { + fla_dgesvd_nn_small1T(m, n, &a[a_offset], lda, &s[1], &work[1], info); + } else +#endif + { + ie = 1; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in A */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__2, &ierr); + if (wntuo || wntuas) { + /* If left singular vectors desired, generate Q */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__2, &ierr); + } + iwork = ie + *m; + nru = 0; + if (wntuo || wntuas) { + nru = *m; + } + /* Perform bidiagonal QR iteration, computing left singular */ + /* vectors of A in A if desired */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, &c__0, &nru, &c__0, &s[1], &work[ie], dum, + &c__1, &a[a_offset], lda, dum, &c__1, &work[iwork], + info); + /* If left singular vectors desired in U, copy them there */ + if (wntuas) { + dlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu); + } + } + } else if (wntvo && wntun) { + /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ + /* M right singular vectors to be overwritten on A and */ + /* no left singular vectors to be computed */ + /* Computing MAX */ + i__2 = *m << 2; + if (*lwork >= *m * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *lda * *n + *m; // , expr subst + if (*lwork >= fla_max(i__2, i__3) + *lda * *m) { + /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */ + ldwrku = *lda; + chunk = *n; + ldwrkr = *lda; + } else /* if(complicated condition) */ + { + /* Computing MAX */ + i__2 = wrkbl; + i__3 = *lda * *n + *m; // , expr subst + if (*lwork >= fla_max(i__2, i__3) + *m * *m) { + /* WORK(IU) is LDA by N and WORK(IR) is M by M */ + ldwrku = *lda; + chunk = *n; + ldwrkr = *m; + } else { + /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */ + ldwrku = *m; + chunk = (*lwork - *m * *m - *m) / *m; + ldwrkr = *m; } - else if (wntvs && wntuo) { - /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*m << 1) * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + } + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy L to WORK(IR) and zero out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], + &ldwrkr); + /* Generate Q in A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IR) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, &ierr); + /* Generate right vectors bidiagonalizing L */ + /* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of L in WORK(IR) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork], info); + iu = ie + *m; + /* Multiply right singular vectors of L in WORK(IR) by Q */ + /* in A, storing result in WORK(IU) and copying to A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M*N + M) */ + i__2 = *n; + i__3 = chunk; + for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) { + /* Computing MIN */ + i__4 = *n - i__ + 1; + blk = fla_min(i__4, chunk); + dgemm_("N", "N", m, &blk, m, &c_b79, &work[ir], &ldwrkr, + &a[i__ * a_dim1 + 1], lda, &c_b57, &work[iu], &ldwrku); + dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ * a_dim1 + 1], + lda); + /* L30: */ + } + } else { + /* Insufficient workspace for a fast algorithm */ + ie = 1; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize A */ + /* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__3, &ierr); + /* Generate right vectors bidiagonalizing A */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__3, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of A in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("L", m, n, &c__0, &c__0, &s[1], &work[ie], &a[a_offset], + lda, dum, &c__1, dum, &c__1, &work[iwork], info); + } + } else if (wntvo && wntuas) { + /* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O') */ + /* M right singular vectors to be overwritten on A and */ + /* M left singular vectors to be computed in U */ + /* Computing MAX */ + i__3 = *m << 2; + if (*lwork >= *m * *m + fla_max(i__3, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + /* Computing MAX */ + i__3 = wrkbl; + i__2 = *lda * *n + *m; // , expr subst + if (*lwork >= fla_max(i__3, i__2) + *lda * *m) { + /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */ + ldwrku = *lda; + chunk = *n; + ldwrkr = *lda; + } else /* if(complicated condition) */ + { + /* Computing MAX */ + i__3 = wrkbl; + i__2 = *lda * *n + *m; // , expr subst + if (*lwork >= fla_max(i__3, i__2) + *m * *m) { + /* WORK(IU) is LDA by N and WORK(IR) is M by M */ + ldwrku = *lda; + chunk = *n; + ldwrkr = *m; + } else { + /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */ + ldwrku = *m; + chunk = (*lwork - *m * *m - *m) / *m; + ldwrkr = *m; } - else if (wntvs && wntuas) { - /* Path 6t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='S') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqm; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + } + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__3, &ierr); + /* Copy L to U, zeroing about above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); + i__3 = *m - 1; + i__2 = *m - 1; + dlaset_("U", &i__3, &i__2, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], + ldu); + /* Generate Q in A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], + &i__3, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in U, copying result to WORK(IR) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__3, &ierr); + dlacpy_("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr); + /* Generate right vectors bidiagonalizing L in WORK(IR) */ + /* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__3, &ierr); + /* Generate left vectors bidiagonalizing L in U */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ + i__3 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__3, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of L in U, and computing right */ + /* singular vectors of L in WORK(IR) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + iu = ie + *m; + /* Multiply right singular vectors of L in WORK(IR) by Q */ + /* in A, storing result in WORK(IU) and copying to A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M*N + M)) */ + i__3 = *n; + i__2 = chunk; + for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ += i__2) { + /* Computing MIN */ + i__4 = *n - i__ + 1; + blk = fla_min(i__4, chunk); + dgemm_("N", "N", m, &blk, m, &c_b79, &work[ir], &ldwrkr, + &a[i__ * a_dim1 + 1], lda, &c_b57, &work[iu], &ldwrku); + dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ * a_dim1 + 1], + lda); + /* L40: */ + } + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy L to U, zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], + ldu); + /* Generate Q in A */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in U */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__2, &ierr); + /* Multiply right vectors bidiagonalizing L by Q in A */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[itaup], + &a[a_offset], lda, &work[iwork], &i__2, &ierr); + /* Generate left vectors bidiagonalizing L in U */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &a[a_offset], + lda, &u[u_offset], ldu, dum, &c__1, &work[iwork], info); + } + } else if (wntvs) { + if (wntun) { + /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ + /* M right singular vectors to be computed in VT and */ + /* no left singular vectors to be computed */ + /* Computing MAX */ + i__2 = *m << 2; + if (*lwork >= *m * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + if (*lwork >= wrkbl + *lda * *m) { + /* WORK(IR) is LDA by M */ + ldwrkr = *lda; + } else { + /* WORK(IR) is M by M */ + ldwrkr = *m; } - else if (wntva && wntun) { - /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy L to WORK(IR), zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], + &ldwrkr); + /* Generate Q in A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IR) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Generate right vectors bidiagonalizing L in */ + /* WORK(IR) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of L in WORK(IR) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork], info); + /* Multiply right singular vectors of L in WORK(IR) by */ + /* Q in A, storing result in VT */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[ir], &ldwrkr, &a[a_offset], + lda, &c_b57, &vt[vt_offset], ldvt); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy result to VT */ + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Zero out above L in A */ + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], + lda); + /* Bidiagonalize L in A */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right vectors bidiagonalizing L by Q in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, + &work[iwork], info); + } + } else if (wntuo) { + /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ + /* M right singular vectors to be computed in VT and */ + /* M left singular vectors to be overwritten on A */ + /* Computing MAX */ + i__2 = *m << 2; + if (*lwork >= (*m << 1) * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + (*lda << 1) * *m) { + /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */ + ldwrku = *lda; + ir = iu + ldwrku * *m; + ldwrkr = *lda; + } else if (*lwork >= wrkbl + (*lda + *m) * *m) { + /* WORK(IU) is LDA by M and WORK(IR) is M by M */ + ldwrku = *lda; + ir = iu + ldwrku * *m; + ldwrkr = *m; + } else { + /* WORK(IU) is M by M and WORK(IR) is M by M */ + ldwrku = *m; + ir = iu + ldwrku * *m; + ldwrkr = *m; } - else if (wntva && wntuo) { - /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = (*m << 1) * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy L to WORK(IU), zeroing out below it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], + &ldwrku); + /* Generate Q in A */ + /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IU), copying result to */ + /* WORK(IR) */ + /* (Workspace: need 2*M*M + 4*M, */ + /* prefer 2*M*M+3*M+2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &ldwrkr); + /* Generate right bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need 2*M*M + 4*M-1, */ + /* prefer 2*M*M+3*M+(M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup], + &work[iwork], &i__2, &ierr); + /* Generate left bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of L in WORK(IR) and computing */ + /* right singular vectors of L in WORK(IU) */ + /* (Workspace: need 2*M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], + &ldwrku, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], + info); + /* Multiply right singular vectors of L in WORK(IU) by */ + /* Q in A, storing result in VT */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, &a[a_offset], + lda, &c_b57, &vt[vt_offset], ldvt); + /* Copy left singular vectors of L to A */ + /* (Workspace: need M*M) */ + dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Zero out above L in A */ + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], + lda); + /* Bidiagonalize L in A */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right vectors bidiagonalizing L by Q in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + /* Generate left bidiagonalizing vectors of L in A */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, compute left */ + /* singular vectors of A in A and compute right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &a[a_offset], lda, dum, &c__1, &work[iwork], + info); + } + } else if (wntuas) { + /* Path 6t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='S') */ + /* M right singular vectors to be computed in VT and */ + /* M left singular vectors to be computed in U */ + /* Computing MAX */ + i__2 = *m << 2; + if (*lwork >= *m * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + *lda * *m) { + /* WORK(IU) is LDA by N */ + ldwrku = *lda; + } else { + /* WORK(IU) is LDA by M */ + ldwrku = *m; } - else if (wntva && wntuas) { - /* Path 9t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='A') */ - wrkbl = *m + lwork_dgelqf; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m + lwork_dorglqn; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dgebrd; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - wrkbl = fla_max(i__2,i__3); - /* Computing MAX */ - i__2 = wrkbl; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - wrkbl = fla_max(i__2,i__3); - wrkbl = fla_max(wrkbl,bdspac); - maxwrk = *m * *m + wrkbl; - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + itau = iu + ldwrku * *m; + iwork = itau + *m; + /* Compute A=L*Q */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + /* Copy L to WORK(IU), zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], + &ldwrku); +#if FLA_ENABLE_AMD_OPT + if (*n < 128 && global_context.is_avx2) { + fla_dgesvd_small6T(m, n, &work[iu], &ldwrku, &a[a_offset], lda, + &s[1], &u[u_offset], ldu, &vt[vt_offset], ldvt, + &work[1], info); + } else +#endif + { + /* Generate Q in A */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IU), copying result to U */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu); + /* Generate right bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need M*M + 4*M-1, */ + /* prefer M*M+3*M+(M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup], + &work[iwork], &i__2, &ierr); + /* Generate left bidiagonalizing vectors in U */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of L in U and computing right */ + /* singular vectors of L in WORK(IU) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], + &ldwrku, &u[u_offset], ldu, dum, &c__1, + &work[iwork], info); + /* Multiply right singular vectors of L in WORK(IU) by */ + /* Q in A, storing result in VT */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, + &a[a_offset], lda, &c_b57, &vt[vt_offset], ldvt); } + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + /* Copy L to U, zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], + ldu); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in U */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right bidiagonalizing vectors in U by Q */ + /* in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + /* Generate left bidiagonalizing vectors in U */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } } - else { - /* Path 10t(N greater than M, but not much larger) */ - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], dum, dum, dum, dum, & c_n1, &ierr); - lwork_dgebrd = (integer) dum[0]; - maxwrk = *m * 3 + lwork_dgebrd; - if (wntvs || wntvo) { - /* Compute space needed for DORGBR P */ - lapack_dorgbr("P", m, n, m, &a[a_offset], n, dum, dum, &c_n1, & ierr); - lwork_dorgbrp = (integer) dum[0]; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); + } else if (wntva) { + if (wntun) { + /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ + /* N right singular vectors to be computed in VT and */ + /* no left singular vectors to be computed */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *m << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= *m * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + ir = 1; + if (*lwork >= wrkbl + *lda * *m) { + /* WORK(IR) is LDA by M */ + ldwrkr = *lda; + } else { + /* WORK(IR) is M by M */ + ldwrkr = *m; } - if (wntva) { - lapack_dorgbr("P", n, n, m, &a[a_offset], n, dum, dum, &c_n1, & ierr); - lwork_dorgbrp = (integer) dum[0]; - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrp; // , expr subst - maxwrk = fla_max(i__2,i__3); + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Copy L to WORK(IR), zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], + &ldwrkr); + /* Generate Q in VT */ + /* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IR) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Generate right bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need M*M + 4*M-1, */ + /* prefer M*M+3*M+(M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of L in WORK(IR) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], + &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork], info); + /* Multiply right singular vectors of L in WORK(IR) by */ + /* Q in VT, storing result in A */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[ir], &ldwrkr, + &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); + /* Copy right singular vectors of A from A to VT */ + dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need M + N, prefer M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Zero out above L in A */ + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], + lda); + /* Bidiagonalize L in A */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right bidiagonalizing vectors in A by Q */ + /* in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, + &work[iwork], info); + } + } else if (wntuo) { + /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ + /* N right singular vectors to be computed in VT and */ + /* M left singular vectors to be overwritten on A */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *m << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= (*m << 1) * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + (*lda << 1) * *m) { + /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */ + ldwrku = *lda; + ir = iu + ldwrku * *m; + ldwrkr = *lda; + } else if (*lwork >= wrkbl + (*lda + *m) * *m) { + /* WORK(IU) is LDA by M and WORK(IR) is M by M */ + ldwrku = *lda; + ir = iu + ldwrku * *m; + ldwrkr = *m; + } else { + /* WORK(IU) is M by M and WORK(IR) is M by M */ + ldwrku = *m; + ir = iu + ldwrku * *m; + ldwrkr = *m; } - if (! wntun) { - /* Computing MAX */ - i__2 = maxwrk; i__3 = *m * 3 + lwork_dorgbrq; // , expr subst - maxwrk = fla_max(i__2,i__3); + itau = ir + ldwrkr * *m; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need 2*M*M + M + N, prefer 2*M*M + M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + /* Copy L to WORK(IU), zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], + &ldwrku); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IU), copying result to */ + /* WORK(IR) */ + /* (Workspace: need 2*M*M + 4*M, */ + /* prefer 2*M*M+3*M+2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &ldwrkr); + /* Generate right bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need 2*M*M + 4*M-1, */ + /* prefer 2*M*M+3*M+(M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup], + &work[iwork], &i__2, &ierr); + /* Generate left bidiagonalizing vectors in WORK(IR) */ + /* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of L in WORK(IR) and computing */ + /* right singular vectors of L in WORK(IU) */ + /* (Workspace: need 2*M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], + &ldwrku, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], + info); + /* Multiply right singular vectors of L in WORK(IU) by */ + /* Q in VT, storing result in A */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, + &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); + /* Copy right singular vectors of A from A to VT */ + dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Copy left singular vectors of A from WORK(IR) to A */ + dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need M + N, prefer M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Zero out above L in A */ + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], + lda); + /* Bidiagonalize L in A */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right bidiagonalizing vectors in A by Q */ + /* in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + /* Generate left bidiagonalizing vectors in A */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in A and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &a[a_offset], lda, dum, &c__1, &work[iwork], + info); + } + } else if (wntuas) { + /* Path 9t(N much larger than M, JOBU='S' or 'A', */ + /* JOBVT='A') */ + /* N right singular vectors to be computed in VT and */ + /* M left singular vectors to be computed in U */ + /* Computing MAX */ + i__2 = *n + *m; + i__3 = *m << 2; + i__2 = fla_max(i__2, i__3); // ; expr subst + if (*lwork >= *m * *m + fla_max(i__2, bdspac)) { + /* Sufficient workspace for a fast algorithm */ + iu = 1; + if (*lwork >= wrkbl + *lda * *m) { + /* WORK(IU) is LDA by M */ + ldwrku = *lda; + } else { + /* WORK(IU) is M by M */ + ldwrku = *m; } - maxwrk = fla_max(maxwrk,bdspac); - /* Computing MAX */ - i__2 = *m * 3 + *n; - minwrk = fla_max(i__2,bdspac); + itau = iu + ldwrku * *m; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + /* Copy L to WORK(IU), zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], + &ldwrku); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in WORK(IU), copying result to U */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu); + /* Generate right bidiagonalizing vectors in WORK(IU) */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup], + &work[iwork], &i__2, &ierr); + /* Generate left bidiagonalizing vectors in U */ + /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of L in U and computing right */ + /* singular vectors of L in WORK(IU) */ + /* (Workspace: need M*M + BDSPAC) */ + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], + &ldwrku, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + /* Multiply right singular vectors of L in WORK(IU) by */ + /* Q in VT, storing result in A */ + /* (Workspace: need M*M) */ + dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, + &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); + /* Copy right singular vectors of A from A to VT */ + dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + } else { + /* Insufficient workspace for a fast algorithm */ + itau = 1; + iwork = itau + *m; + /* Compute A=L*Q, copying result to VT */ + /* (Workspace: need 2*M, prefer M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], + &i__2, &ierr); + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + /* Generate Q in VT */ + /* (Workspace: need M + N, prefer M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], + &work[iwork], &i__2, &ierr); + /* Copy L to U, zeroing out above it */ + dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); + i__2 = *m - 1; + i__3 = *m - 1; + dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], + ldu); + ie = itau; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize L in U */ + /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], + &work[itauq], &work[itaup], &work[iwork], &i__2, + &ierr); + /* Multiply right bidiagonalizing vectors in U by Q */ + /* in VT */ + /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, + &work[itaup], &vt[vt_offset], ldvt, &work[iwork], + &i__2, &ierr); + /* Generate left bidiagonalizing vectors in U */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + iwork = ie + *m; + /* Perform bidiagonal QR iteration, computing left */ + /* singular vectors of A in U and computing right */ + /* singular vectors of A in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], + ldvt, &u[u_offset], ldu, dum, &c__1, &work[iwork], + info); + } } + } + } else { + /* N .LT. MNTHR */ + /* Reduce to bidiagonal form without LQ decomposition */ + ie = 1; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + /* Bidiagonalize A */ + /* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], + &work[itaup], &work[iwork], &i__2, &ierr); + if (wntuas) { + /* If left singular vectors desired in U, copy result to U */ + /* and generate left bidiagonalizing vectors in U */ + /* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) */ + dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, n, &u[u_offset], ldu, &work[itauq], + &work[iwork], &i__2, &ierr); + } + if (wntvas) { + /* If right singular vectors desired in VT, copy result to */ + /* VT and generate right bidiagonalizing vectors in VT */ + /* (Workspace: need 3*M + NRVT, prefer 3*M + NRVT*NB) */ + dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); + if (wntva) { + nrvt = *n; + } + if (wntvs) { + nrvt = *m; + } + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", &nrvt, n, m, &vt[vt_offset], ldvt, &work[itaup], + &work[iwork], &i__2, &ierr); + } + if (wntuo) { + /* If left singular vectors desired in A, generate left */ + /* bidiagonalizing vectors in A */ + /* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("Q", m, m, n, &a[a_offset], lda, &work[itauq], + &work[iwork], &i__2, &ierr); + } + if (wntvo) { + /* If right singular vectors desired in A, generate right */ + /* bidiagonalizing vectors in A */ + /* (Workspace: need 4*M, prefer 3*M + M*NB) */ + i__2 = *lwork - iwork + 1; + lapack_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], + &work[iwork], &i__2, &ierr); + } + iwork = ie + *m; + if (wntuas || wntuo) { + nru = *m; + } + if (wntun) { + nru = 0; + } + if (wntvas || wntvo) { + ncvt = *n; + } + if (wntvn) { + ncvt = 0; + } + if (!wntuo && !wntvo) { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in U and computing right singular */ + /* vectors in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, + &work[iwork], info); + } else if (!wntuo && wntvo) { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in U and computing right singular */ + /* vectors in A */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], + &a[a_offset], lda, &u[u_offset], ldu, dum, &c__1, + &work[iwork], info); + } else { + /* Perform bidiagonal QR iteration, if desired, computing */ + /* left singular vectors in A and computing right singular */ + /* vectors in VT */ + /* (Workspace: need BDSPAC) */ + lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], + &vt[vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, + &work[iwork], info); + } } - maxwrk = fla_max(maxwrk,minwrk); - work[1] = (doublereal) maxwrk; - if (*lwork < minwrk && ! lquery) { - *info = -13; + } + /* If lapack_dbdsqr failed to converge, copy unconverged superdiagonals */ + /* to WORK( 2:MINMN ) */ + if (*info != 0) { + if (ie > 2) { + i__2 = minmn - 1; + for (i__ = 1; i__ <= i__2; ++i__) { + work[i__ + 1] = work[i__ + ie - 1]; + /* L50: */ + } } - } -#endif - if (*info != 0) { - i__2 = -(*info); - xerbla_("DGESVD", &i__2); - return 0; - } - else if (lquery) { - return 0; - } - /* Quick return if possible */ - if (*m == 0 || *n == 0) { - return 0; - } - /* Get machine constants */ - static int r_once = 1; - - if (r_once) /* TODO: Remove with Global context */ - { - eps = dlamch_("P"); - smlnum = sqrt(dlamch_("S")) / eps; - bignum = 1. / smlnum; - r_once = 0; - } - /* Scale A if max element outside range [SMLNUM,BIGNUM] */ - anrm = dlange_("M", m, n, &a[a_offset], lda, dum); - iscl = 0; - if (anrm > 0. && anrm < smlnum) { - iscl = 1; - dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, & ierr); - } - else if (anrm > bignum) { - iscl = 1; - dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, & ierr); - } - if (*m >= *n) { - /* A has at least as many rows as columns. If A has sufficiently */ - /* more rows than columns, first reduce using the QR */ - /* decomposition (if sufficient workspace available) */ - if (*m >= mnthr) { - if (wntun) { - /* Path 1 (M much larger than N, JOBU='N') */ - /* No left singular vectors to be computed */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], & i__2, &ierr); - /* Zero out below R */ - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[a_dim1 + 2], lda); - } - ie = 1; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in A */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__2, &ierr); - ncvt = 0; - if (wntvo || wntvas) { - /* If right singular vectors desired, generate P'. */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], & work[iwork], &i__2, &ierr); - ncvt = *n; - } - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of A in A if desired */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &ncvt, &c__0, &c__0, &s[1], &work[ie], &a[ a_offset], lda, dum, &c__1, dum, &c__1, &work[iwork], info); - /* If right singular vectors desired in VT, copy them there */ - if (wntvas) { - dlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - } - } - else if (wntuo && wntvn) { - /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */ - /* N left singular vectors to be overwritten on A and */ - /* no right singular vectors to be computed */ - /* Computing MAX */ - i__2 = *n << 2; - if (*lwork >= *n * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *lda * *n + *n; // , expr subst - if (*lwork >= fla_max(i__2,i__3) + *lda * *n) { - /* WORK(IU) is LDA by N, WORK(IR) is LDA by N */ - ldwrku = *lda; - ldwrkr = *lda; - } - else /* if(complicated condition) */ - { - /* Computing MAX */ - i__2 = wrkbl; i__3 = *lda * *n + *n; // , expr subst - if (*lwork >= fla_max(i__2,i__3) + *n * *n) { - /* WORK(IU) is LDA by N, WORK(IR) is N by N */ - ldwrku = *lda; - ldwrkr = *n; - } - else { - /* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */ - ldwrku = (*lwork - *n * *n - *n) / *n; - ldwrkr = *n; - } - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__2, &ierr); - /* Copy R to WORK(IR) and zero out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); - /* Generate Q in A */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__2, &ierr); - /* Generate left vectors bidiagonalizing R */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], & work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IR) */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, & c__1, &work[ir], &ldwrkr, dum, &c__1, &work[iwork] , info); - iu = ie + *n; - /* Multiply Q in A by left singular vectors of R in */ - /* WORK(IR), storing result in WORK(IU) and copying to A */ - /* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) */ - i__2 = *m; - i__3 = ldwrku; - for (i__ = 1; - i__3 < 0 ? i__ >= i__2 : i__ <= i__2; - i__ += i__3) { - /* Computing MIN */ - i__4 = *m - i__ + 1; - chunk = fla_min(i__4,ldwrku); - dgemm_("N", "N", &chunk, n, n, &c_b79, &a[i__ + a_dim1], lda, &work[ir], &ldwrkr, &c_b57, & work[iu], &ldwrku); - dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + a_dim1], lda); - /* L10: */ - } - } - else { - /* Insufficient workspace for a fast algorithm */ - ie = 1; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize A */ - /* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__3, &ierr); - /* Generate left vectors bidiagonalizing A */ - /* (Workspace: need 4*N, prefer 3*N + N*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], & work[iwork], &i__3, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, & c__1, &a[a_offset], lda, dum, &c__1, &work[iwork], info); - } - } - else if (wntuo && wntvas) { - /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A') */ - /* N left singular vectors to be overwritten on A and */ - /* N right singular vectors to be computed in VT */ - /* Computing MAX */ - i__3 = *n << 2; - if (*lwork >= *n * *n + fla_max(i__3,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - /* Computing MAX */ - i__3 = wrkbl; i__2 = *lda * *n + *n; // , expr subst - if (*lwork >= fla_max(i__3,i__2) + *lda * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ - ldwrku = *lda; - ldwrkr = *lda; - } - else /* if(complicated condition) */ - { - /* Computing MAX */ - i__3 = wrkbl; i__2 = *lda * *n + *n; // , expr subst - if (*lwork >= fla_max(i__3,i__2) + *n * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is N by N */ - ldwrku = *lda; - ldwrkr = *n; - } - else { - /* WORK(IU) is LDWRKU by N and WORK(IR) is N by N */ - ldwrku = (*lwork - *n * *n - *n) / *n; - ldwrkr = *n; - } - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__3 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__3, &ierr); - /* Copy R to VT, zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - if (*n > 1) { - i__3 = *n - 1; - i__2 = *n - 1; - dlaset_("L", &i__3, &i__2, &c_b57, &c_b57, &vt[ vt_dim1 + 2], ldvt); - } - /* Generate Q in A */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__3, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in VT, copying result to WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], &i__3, & ierr); - dlacpy_("L", n, n, &vt[vt_offset], ldvt, &work[ir], & ldwrkr); - /* Generate left vectors bidiagonalizing R in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], & work[iwork], &i__3, &ierr); - /* Generate right vectors bidiagonalizing R in VT */ - /* (Workspace: need N*N + 4*N-1, prefer N*N + 3*N + (N-1)*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__3, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IR) and computing right */ - /* singular vectors of R in VT */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); - iu = ie + *n; - /* Multiply Q in A by left singular vectors of R in */ - /* WORK(IR), storing result in WORK(IU) and copying to A */ - /* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) */ - i__3 = *m; - i__2 = ldwrku; - for (i__ = 1; - i__2 < 0 ? i__ >= i__3 : i__ <= i__3; - i__ += i__2) { - /* Computing MIN */ - i__4 = *m - i__ + 1; - chunk = fla_min(i__4,ldwrku); - dgemm_("N", "N", &chunk, n, n, &c_b79, &a[i__ + a_dim1], lda, &work[ir], &ldwrkr, &c_b57, & work[iu], &ldwrku); - dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + a_dim1], lda); - /* L20: */ - } - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__2, &ierr); - /* Copy R to VT, zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[ vt_dim1 + 2], ldvt); - } - /* Generate Q in A */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in VT */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], &i__2, & ierr); - /* Multiply Q in A by left vectors bidiagonalizing R */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, & work[itauq], &a[a_offset], lda, &work[iwork], & i__2, &ierr); - /* Generate right vectors bidiagonalizing R in VT */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in A and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, & work[iwork], info); - } - } - else if (wntus) { - if (wntvn) { - /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */ - /* N left singular vectors to be computed in U and */ - /* no right singular vectors to be computed */ - /* Computing MAX */ - i__2 = *n << 2; - if (*lwork >= *n * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - if (*lwork >= wrkbl + *lda * *n) { - /* WORK(IR) is LDA by N */ - ldwrkr = *lda; - } - else { - /* WORK(IR) is N by N */ - ldwrkr = *n; - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy R to WORK(IR), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], & ldwrkr); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); - /* Generate Q in A */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Generate left vectors bidiagonalizing R in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq] , &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IR) */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, & work[iwork], info); - /* Multiply Q in A by left singular vectors of R in */ - /* WORK(IR), storing result in U */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, & work[ir], &ldwrkr, &c_b57, &u[u_offset], ldu); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Zero out below R in A */ - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[ a_dim1 + 2], lda); - } - /* Bidiagonalize R in A */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left vectors bidiagonalizing R */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, & work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - } - } - else if (wntvo) { - /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */ - /* N left singular vectors to be computed in U and */ - /* N right singular vectors to be overwritten on A */ - /* Computing MAX */ - i__2 = *n << 2; - if (*lwork >= (*n << 1) * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + (*lda << 1) * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ - ldwrku = *lda; - ir = iu + ldwrku * *n; - ldwrkr = *lda; - } - else if (*lwork >= wrkbl + (*lda + *n) * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is N by N */ - ldwrku = *lda; - ir = iu + ldwrku * *n; - ldwrkr = *n; - } - else { - /* WORK(IU) is N by N and WORK(IR) is N by N */ - ldwrku = *n; - ir = iu + ldwrku * *n; - ldwrkr = *n; - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy R to WORK(IU), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); - /* Generate Q in A */ - /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IU), copying result to */ - /* WORK(IR) */ - /* (Workspace: need 2*N*N + 4*N, */ - /* prefer 2*N*N+3*N+2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], & ldwrkr); - /* Generate left bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq] , &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need 2*N*N + 4*N-1, */ - /* prefer 2*N*N+3*N+(N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup] , &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IU) and computing */ - /* right singular vectors of R in WORK(IR) */ - /* (Workspace: need 2*N*N + BDSPAC) */ - lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[ ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1, &work[iwork], info); - /* Multiply Q in A by left singular vectors of R in */ - /* WORK(IU), storing result in U */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, & work[iu], &ldwrku, &c_b57, &u[u_offset], ldu); - /* Copy right singular vectors of R to A */ - /* (Workspace: need N*N) */ - dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Zero out below R in A */ - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[ a_dim1 + 2], lda); - } - /* Bidiagonalize R in A */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left vectors bidiagonalizing R */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, & work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr) ; - /* Generate right vectors bidiagonalizing R in A */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[ a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[iwork], info); - } - } - else if (wntvas) { - /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' */ - /* or 'A') */ - /* N left singular vectors to be computed in U and */ - /* N right singular vectors to be computed in VT */ - /* Computing MAX */ - i__2 = *n << 2; - if (*lwork >= *n * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + *lda * *n) { - /* WORK(IU) is LDA by N */ - ldwrku = *lda; - } - else { - /* WORK(IU) is N by N */ - ldwrku = *n; - } - itau = iu + ldwrku * *n; - iwork = itau + *n; - /* Compute A=Q*R */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy R to WORK(IU), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); - /* Generate Q in A */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IU), copying result to VT */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt); - /* Generate left bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq] , &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in VT */ - /* (Workspace: need N*N + 4*N-1, */ - /* prefer N*N+3*N+(N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[ itaup], &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IU) and computing */ - /* right singular vectors of R in VT */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &work[iu], &ldwrku, dum, & c__1, &work[iwork], info); - /* Multiply Q in A by left singular vectors of R in */ - /* WORK(IU), storing result in U */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &a[a_offset], lda, & work[iu], &ldwrku, &c_b57, &u[u_offset], ldu); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy R to VT, zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[ vt_dim1 + 2], ldvt); - } - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in VT */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left bidiagonalizing vectors */ - /* in VT */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in VT */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[ itaup], &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, & c__1, &work[iwork], info); - } - } - } - else if (wntua) { - if (wntvn) { - /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */ - /* M left singular vectors to be computed in U and */ - /* no right singular vectors to be computed */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *n << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= *n * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - if (*lwork >= wrkbl + *lda * *n) { - /* WORK(IR) is LDA by N */ - ldwrkr = *lda; - } - else { - /* WORK(IR) is N by N */ - ldwrkr = *n; - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Copy R to WORK(IR), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], & ldwrkr); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[ir + 1], &ldwrkr); - /* Generate Q in U */ - /* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Generate left bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq] , &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IR) */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, & work[iwork], info); - /* Multiply Q in U by left singular vectors of R in */ - /* WORK(IR), storing result in A */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, & work[ir], &ldwrkr, &c_b57, &a[a_offset], lda); - /* Copy left singular vectors of A from A to U */ - dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need N + M, prefer N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Zero out below R in A */ - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[ a_dim1 + 2], lda); - } - /* Bidiagonalize R in A */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left bidiagonalizing vectors */ - /* in A */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, & work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - } - } - else if (wntvo) { - /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */ - /* M left singular vectors to be computed in U and */ - /* N right singular vectors to be overwritten on A */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *n << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= (*n << 1) * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + (*lda << 1) * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */ - ldwrku = *lda; - ir = iu + ldwrku * *n; - ldwrkr = *lda; - } - else if (*lwork >= wrkbl + (*lda + *n) * *n) { - /* WORK(IU) is LDA by N and WORK(IR) is N by N */ - ldwrku = *lda; - ir = iu + ldwrku * *n; - ldwrkr = *n; - } - else { - /* WORK(IU) is N by N and WORK(IR) is N by N */ - ldwrku = *n; - ir = iu + ldwrku * *n; - ldwrkr = *n; - } - itau = ir + ldwrkr * *n; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need 2*N*N + N + M, prefer 2*N*N + N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy R to WORK(IU), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IU), copying result to */ - /* WORK(IR) */ - /* (Workspace: need 2*N*N + 4*N, */ - /* prefer 2*N*N+3*N+2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], & ldwrkr); - /* Generate left bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq] , &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need 2*N*N + 4*N-1, */ - /* prefer 2*N*N+3*N+(N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup] , &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IU) and computing */ - /* right singular vectors of R in WORK(IR) */ - /* (Workspace: need 2*N*N + BDSPAC) */ - lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[ ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1, &work[iwork], info); - /* Multiply Q in U by left singular vectors of R in */ - /* WORK(IU), storing result in A */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, & work[iu], &ldwrku, &c_b57, &a[a_offset], lda); - /* Copy left singular vectors of A from A to U */ - dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Copy right singular vectors of R from WORK(IR) to A */ - dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need N + M, prefer N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Zero out below R in A */ - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &a[ a_dim1 + 2], lda); - } - /* Bidiagonalize R in A */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left bidiagonalizing vectors */ - /* in A */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, & work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr) ; - /* Generate right bidiagonalizing vectors in A */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2, &ierr); - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[ a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[iwork], info); - } - } - else if (wntvas) { - /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' */ - /* or 'A') */ - /* M left singular vectors to be computed in U and */ - /* N right singular vectors to be computed in VT */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *n << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= *n * *n + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + *lda * *n) { - /* WORK(IU) is LDA by N */ - ldwrku = *lda; - } - else { - /* WORK(IU) is N by N */ - ldwrku = *n; - } - itau = iu + ldwrku * *n; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy R to WORK(IU), zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &work[iu + 1], &ldwrku); - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in WORK(IU), copying result to VT */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt); - /* Generate left bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq] , &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in VT */ - /* (Workspace: need N*N + 4*N-1, */ - /* prefer N*N+3*N+(N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[ itaup], &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of R in WORK(IU) and computing */ - /* right singular vectors of R in VT */ - /* (Workspace: need N*N + BDSPAC) */ - lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &work[iu], &ldwrku, dum, & c__1, &work[iwork], info); - /* Multiply Q in U by left singular vectors of R in */ - /* WORK(IU), storing result in A */ - /* (Workspace: need N*N) */ - dgemm_("N", "N", m, n, n, &c_b79, &u[u_offset], ldu, & work[iu], &ldwrku, &c_b57, &a[a_offset], lda); - /* Copy left singular vectors of A from A to U */ - dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *n; - /* Compute A=Q*R, copying result to U */ - /* (Workspace: need 2*N, prefer N + N*NB) */ - i__2 = *lwork - iwork + 1; - dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - /* Generate Q in U */ - /* (Workspace: need N + M, prefer N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy R from A to VT, zeroing out below it */ - dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - if (*n > 1) { - i__2 = *n - 1; - i__3 = *n - 1; - dlaset_("L", &i__2, &i__3, &c_b57, &c_b57, &vt[ vt_dim1 + 2], ldvt); - } - ie = itau; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize R in VT */ - /* (Workspace: need 4*N, prefer 3*N + 2*N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply Q in U by left bidiagonalizing vectors */ - /* in VT */ - /* (Workspace: need 3*N + M, prefer 3*N + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &work[itauq], &u[u_offset], ldu, &work[iwork], &i__2, &ierr); - /* Generate right bidiagonalizing vectors in VT */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[ itaup], &work[iwork], &i__2, &ierr) ; - iwork = ie + *n; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, & c__1, &work[iwork], info); - } - } - } - } - else { - /* M .LT. MNTHR */ - /* Path 10 (M at least N, but not much larger) */ - /* Reduce to bidiagonal form without QR decomposition */ - ie = 1; - itauq = ie + *n; - itaup = itauq + *n; - iwork = itaup + *n; - /* Bidiagonalize A */ - /* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], & work[itaup], &work[iwork], &i__2, &ierr); - if (wntuas) { - /* If left singular vectors desired in U, copy result to U */ - /* and generate left bidiagonalizing vectors in U */ - /* (Workspace: need 3*N + NCU, prefer 3*N + NCU*NB) */ - dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu); - if (wntus) { - ncu = *n; - } - if (wntua) { - ncu = *m; - } - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], & work[iwork], &i__2, &ierr); - } - if (wntvas) { - /* If right singular vectors desired in VT, copy result to */ - /* VT and generate right bidiagonalizing vectors in VT */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], & work[iwork], &i__2, &ierr); - } - if (wntuo) { - /* If left singular vectors desired in A, generate left */ - /* bidiagonalizing vectors in A */ - /* (Workspace: need 4*N, prefer 3*N + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[ iwork], &i__2, &ierr); - } - if (wntvo) { - /* If right singular vectors desired in A, generate right */ - /* bidiagonalizing vectors in A */ - /* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[ iwork], &i__2, &ierr); - } - iwork = ie + *n; - if (wntuas || wntuo) { - nru = *m; - } - if (wntun) { - nru = 0; - } - if (wntvas || wntvo) { - ncvt = *n; - } - if (wntvn) { - ncvt = 0; - } - if (! wntuo && ! wntvo) { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in U and computing right singular */ - /* vectors in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - } - else if (! wntuo && wntvo) { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in U and computing right singular */ - /* vectors in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[ a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[ iwork], info); - } - else { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in A and computing right singular */ - /* vectors in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, & work[iwork], info); - } - } - } - else { - /* A has more columns than rows. If A has sufficiently more */ - /* columns than rows, first reduce using the LQ decomposition (if */ - /* sufficient workspace available) */ - if (*n >= mnthr) { - if (wntvn) { - /* Path 1t(N much larger than M, JOBVT='N') */ - /* No right singular vectors to be computed */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], & i__2, &ierr); - /* Zero out above L */ - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); - ie = 1; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in A */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__2, &ierr); - if (wntuo || wntuas) { - /* If left singular vectors desired, generate Q */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], & work[iwork], &i__2, &ierr); - } - iwork = ie + *m; - nru = 0; - if (wntuo || wntuas) { - nru = *m; - } - /* Perform bidiagonal QR iteration, computing left singular */ - /* vectors of A in A if desired */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, &c__0, &nru, &c__0, &s[1], &work[ie], dum, & c__1, &a[a_offset], lda, dum, &c__1, &work[iwork], info); - /* If left singular vectors desired in U, copy them there */ - if (wntuas) { - dlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu); - } - } - else if (wntvo && wntun) { - /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */ - /* M right singular vectors to be overwritten on A and */ - /* no left singular vectors to be computed */ - /* Computing MAX */ - i__2 = *m << 2; - if (*lwork >= *m * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - /* Computing MAX */ - i__2 = wrkbl; i__3 = *lda * *n + *m; // , expr subst - if (*lwork >= fla_max(i__2,i__3) + *lda * *m) { - /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */ - ldwrku = *lda; - chunk = *n; - ldwrkr = *lda; - } - else /* if(complicated condition) */ - { - /* Computing MAX */ - i__2 = wrkbl; i__3 = *lda * *n + *m; // , expr subst - if (*lwork >= fla_max(i__2,i__3) + *m * *m) { - /* WORK(IU) is LDA by N and WORK(IR) is M by M */ - ldwrku = *lda; - chunk = *n; - ldwrkr = *m; - } - else { - /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */ - ldwrku = *m; - chunk = (*lwork - *m * *m - *m) / *m; - ldwrkr = *m; - } - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__2, &ierr); - /* Copy L to WORK(IR) and zero out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], &ldwrkr); - /* Generate Q in A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IR) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__2, &ierr); - /* Generate right vectors bidiagonalizing L */ - /* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], & work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of L in WORK(IR) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ ir], &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork] , info); - iu = ie + *m; - /* Multiply right singular vectors of L in WORK(IR) by Q */ - /* in A, storing result in WORK(IU) and copying to A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M*N + M) */ - i__2 = *n; - i__3 = chunk; - for (i__ = 1; - i__3 < 0 ? i__ >= i__2 : i__ <= i__2; - i__ += i__3) { - /* Computing MIN */ - i__4 = *n - i__ + 1; - blk = fla_min(i__4,chunk); - dgemm_("N", "N", m, &blk, m, &c_b79, &work[ir], & ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b57, & work[iu], &ldwrku); - dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ * a_dim1 + 1], lda); - /* L30: */ - } - } - else { - /* Insufficient workspace for a fast algorithm */ - ie = 1; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize A */ - /* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__3, &ierr); - /* Generate right vectors bidiagonalizing A */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], & work[iwork], &i__3, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of A in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("L", m, n, &c__0, &c__0, &s[1], &work[ie], &a[ a_offset], lda, dum, &c__1, dum, &c__1, &work[ iwork], info); - } - } - else if (wntvo && wntuas) { - /* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O') */ - /* M right singular vectors to be overwritten on A and */ - /* M left singular vectors to be computed in U */ - /* Computing MAX */ - i__3 = *m << 2; - if (*lwork >= *m * *m + fla_max(i__3,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - /* Computing MAX */ - i__3 = wrkbl; i__2 = *lda * *n + *m; // , expr subst - if (*lwork >= fla_max(i__3,i__2) + *lda * *m) { - /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */ - ldwrku = *lda; - chunk = *n; - ldwrkr = *lda; - } - else /* if(complicated condition) */ - { - /* Computing MAX */ - i__3 = wrkbl; i__2 = *lda * *n + *m; // , expr subst - if (*lwork >= fla_max(i__3,i__2) + *m * *m) { - /* WORK(IU) is LDA by N and WORK(IR) is M by M */ - ldwrku = *lda; - chunk = *n; - ldwrkr = *m; - } - else { - /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */ - ldwrku = *m; - chunk = (*lwork - *m * *m - *m) / *m; - ldwrkr = *m; - } - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__3, &ierr); - /* Copy L to U, zeroing about above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); - i__3 = *m - 1; - i__2 = *m - 1; - dlaset_("U", &i__3, &i__2, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], ldu); - /* Generate Q in A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[ iwork], &i__3, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in U, copying result to WORK(IR) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__3, &ierr); - dlacpy_("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr); - /* Generate right vectors bidiagonalizing L in WORK(IR) */ - /* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], & work[iwork], &i__3, &ierr); - /* Generate left vectors bidiagonalizing L in U */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ - i__3 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], & work[iwork], &i__3, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of L in U, and computing right */ - /* singular vectors of L in WORK(IR) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, &u[u_offset], ldu, dum, &c__1, &work[ iwork], info); - iu = ie + *m; - /* Multiply right singular vectors of L in WORK(IR) by Q */ - /* in A, storing result in WORK(IU) and copying to A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M*N + M)) */ - i__3 = *n; - i__2 = chunk; - for (i__ = 1; - i__2 < 0 ? i__ >= i__3 : i__ <= i__3; - i__ += i__2) { - /* Computing MIN */ - i__4 = *n - i__ + 1; - blk = fla_min(i__4,chunk); - dgemm_("N", "N", m, &blk, m, &c_b79, &work[ir], & ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b57, & work[iu], &ldwrku); - dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ * a_dim1 + 1], lda); - /* L40: */ - } - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork] , &i__2, &ierr); - /* Copy L to U, zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], ldu); - /* Generate Q in A */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in U */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[ itauq], &work[itaup], &work[iwork], &i__2, &ierr); - /* Multiply right vectors bidiagonalizing L by Q in A */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[ itaup], &a[a_offset], lda, &work[iwork], &i__2, & ierr); - /* Generate left vectors bidiagonalizing L in U */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], & work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &a[ a_offset], lda, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - } - } - else if (wntvs) { - if (wntun) { - /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */ - /* M right singular vectors to be computed in VT and */ - /* no left singular vectors to be computed */ - /* Computing MAX */ - i__2 = *m << 2; - if (*lwork >= *m * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - if (*lwork >= wrkbl + *lda * *m) { - /* WORK(IR) is LDA by M */ - ldwrkr = *lda; - } - else { - /* WORK(IR) is M by M */ - ldwrkr = *m; - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy L to WORK(IR), zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], & ldwrkr); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], &ldwrkr); - /* Generate Q in A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IR) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Generate right vectors bidiagonalizing L in */ - /* WORK(IR) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup] , &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of L in WORK(IR) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], & work[ir], &ldwrkr, dum, &c__1, dum, &c__1, & work[iwork], info); - /* Multiply right singular vectors of L in WORK(IR) by */ - /* Q in A, storing result in VT */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[ir], &ldwrkr, &a[a_offset], lda, &c_b57, &vt[vt_offset], ldvt); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy result to VT */ - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Zero out above L in A */ - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); - /* Bidiagonalize L in A */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right vectors bidiagonalizing L by Q in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], & vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, & work[iwork], info); - } - } - else if (wntuo) { - /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */ - /* M right singular vectors to be computed in VT and */ - /* M left singular vectors to be overwritten on A */ - /* Computing MAX */ - i__2 = *m << 2; - if (*lwork >= (*m << 1) * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + (*lda << 1) * *m) { - /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */ - ldwrku = *lda; - ir = iu + ldwrku * *m; - ldwrkr = *lda; - } - else if (*lwork >= wrkbl + (*lda + *m) * *m) { - /* WORK(IU) is LDA by M and WORK(IR) is M by M */ - ldwrku = *lda; - ir = iu + ldwrku * *m; - ldwrkr = *m; - } - else { - /* WORK(IU) is M by M and WORK(IR) is M by M */ - ldwrku = *m; - ir = iu + ldwrku * *m; - ldwrkr = *m; - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy L to WORK(IU), zeroing out below it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], &ldwrku); - /* Generate Q in A */ - /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IU), copying result to */ - /* WORK(IR) */ - /* (Workspace: need 2*M*M + 4*M, */ - /* prefer 2*M*M+3*M+2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], & ldwrkr); - /* Generate right bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need 2*M*M + 4*M-1, */ - /* prefer 2*M*M+3*M+(M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup] , &work[iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq] , &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of L in WORK(IR) and computing */ - /* right singular vectors of L in WORK(IU) */ - /* (Workspace: need 2*M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); - /* Multiply right singular vectors of L in WORK(IU) by */ - /* Q in A, storing result in VT */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, &a[a_offset], lda, &c_b57, &vt[vt_offset], ldvt); - /* Copy left singular vectors of L to A */ - /* (Workspace: need M*M) */ - dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Zero out above L in A */ - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); - /* Bidiagonalize L in A */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right vectors bidiagonalizing L by Q in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors of L in A */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, compute left */ - /* singular vectors of A in A and compute right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &a[a_offset], lda, dum, & c__1, &work[iwork], info); - } - } - else if (wntuas) { - /* Path 6t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='S') */ - /* M right singular vectors to be computed in VT and */ - /* M left singular vectors to be computed in U */ - /* Computing MAX */ - i__2 = *m << 2; - if (*lwork >= *m * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + *lda * *m) { - /* WORK(IU) is LDA by N */ - ldwrku = *lda; - } - else { - /* WORK(IU) is LDA by M */ - ldwrku = *m; - } - itau = iu + ldwrku * *m; - iwork = itau + *m; - /* Compute A=L*Q */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - /* Copy L to WORK(IU), zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], &ldwrku); - /* Generate Q in A */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &a[a_offset], lda, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IU), copying result to U */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu); - /* Generate right bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need M*M + 4*M-1, */ - /* prefer M*M+3*M+(M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup] , &work[iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in U */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of L in U and computing right */ - /* singular vectors of L in WORK(IU) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - /* Multiply right singular vectors of L in WORK(IU) by */ - /* Q in A, storing result in VT */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, &a[a_offset], lda, &c_b57, &vt[vt_offset], ldvt); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy L to U, zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], ldu); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in U */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right bidiagonalizing vectors in U by Q */ - /* in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in U */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, & c__1, &work[iwork], info); - } - } - } - else if (wntva) { - if (wntun) { - /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */ - /* N right singular vectors to be computed in VT and */ - /* no left singular vectors to be computed */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *m << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= *m * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - ir = 1; - if (*lwork >= wrkbl + *lda * *m) { - /* WORK(IR) is LDA by M */ - ldwrkr = *lda; - } - else { - /* WORK(IR) is M by M */ - ldwrkr = *m; - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Copy L to WORK(IR), zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], & ldwrkr); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[ir + ldwrkr], &ldwrkr); - /* Generate Q in VT */ - /* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IR) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Generate right bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need M*M + 4*M-1, */ - /* prefer M*M+3*M+(M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup] , &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of L in WORK(IR) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], & work[ir], &ldwrkr, dum, &c__1, dum, &c__1, & work[iwork], info); - /* Multiply right singular vectors of L in WORK(IR) by */ - /* Q in VT, storing result in A */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[ir], &ldwrkr, &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); - /* Copy right singular vectors of A from A to VT */ - dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need M + N, prefer M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Zero out above L in A */ - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); - /* Bidiagonalize L in A */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right bidiagonalizing vectors in A by Q */ - /* in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], & vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, & work[iwork], info); - } - } - else if (wntuo) { - /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */ - /* N right singular vectors to be computed in VT and */ - /* M left singular vectors to be overwritten on A */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *m << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= (*m << 1) * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + (*lda << 1) * *m) { - /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */ - ldwrku = *lda; - ir = iu + ldwrku * *m; - ldwrkr = *lda; - } - else if (*lwork >= wrkbl + (*lda + *m) * *m) { - /* WORK(IU) is LDA by M and WORK(IR) is M by M */ - ldwrku = *lda; - ir = iu + ldwrku * *m; - ldwrkr = *m; - } - else { - /* WORK(IU) is M by M and WORK(IR) is M by M */ - ldwrku = *m; - ir = iu + ldwrku * *m; - ldwrkr = *m; - } - itau = ir + ldwrkr * *m; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need 2*M*M + M + N, prefer 2*M*M + M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy L to WORK(IU), zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], &ldwrku); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IU), copying result to */ - /* WORK(IR) */ - /* (Workspace: need 2*M*M + 4*M, */ - /* prefer 2*M*M+3*M+2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], & ldwrkr); - /* Generate right bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need 2*M*M + 4*M-1, */ - /* prefer 2*M*M+3*M+(M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup] , &work[iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in WORK(IR) */ - /* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq] , &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of L in WORK(IR) and computing */ - /* right singular vectors of L in WORK(IU) */ - /* (Workspace: need 2*M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1, &work[iwork], info); - /* Multiply right singular vectors of L in WORK(IU) by */ - /* Q in VT, storing result in A */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); - /* Copy right singular vectors of A from A to VT */ - dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Copy left singular vectors of A from WORK(IR) to A */ - dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need M + N, prefer M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Zero out above L in A */ - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &a[(a_dim1 << 1) + 1], lda); - /* Bidiagonalize L in A */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &a[a_offset], lda, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right bidiagonalizing vectors in A by Q */ - /* in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in A */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in A and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &a[a_offset], lda, dum, & c__1, &work[iwork], info); - } - } - else if (wntuas) { - /* Path 9t(N much larger than M, JOBU='S' or 'A', */ - /* JOBVT='A') */ - /* N right singular vectors to be computed in VT and */ - /* M left singular vectors to be computed in U */ - /* Computing MAX */ - i__2 = *n + *m; i__3 = *m << 2; i__2 = fla_max(i__2,i__3); // ; expr subst - if (*lwork >= *m * *m + fla_max(i__2,bdspac)) { - /* Sufficient workspace for a fast algorithm */ - iu = 1; - if (*lwork >= wrkbl + *lda * *m) { - /* WORK(IU) is LDA by M */ - ldwrku = *lda; - } - else { - /* WORK(IU) is M by M */ - ldwrku = *m; - } - itau = iu + ldwrku * *m; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy L to WORK(IU), zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], & ldwrku); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &work[iu + ldwrku], &ldwrku); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in WORK(IU), copying result to U */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &work[iu], &ldwrku, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu); - /* Generate right bidiagonalizing vectors in WORK(IU) */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup] , &work[iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in U */ - /* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of L in U and computing right */ - /* singular vectors of L in WORK(IU) */ - /* (Workspace: need M*M + BDSPAC) */ - lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - /* Multiply right singular vectors of L in WORK(IU) by */ - /* Q in VT, storing result in A */ - /* (Workspace: need M*M) */ - dgemm_("N", "N", m, n, m, &c_b79, &work[iu], &ldwrku, &vt[vt_offset], ldvt, &c_b57, &a[a_offset], lda); - /* Copy right singular vectors of A from A to VT */ - dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - } - else { - /* Insufficient workspace for a fast algorithm */ - itau = 1; - iwork = itau + *m; - /* Compute A=L*Q, copying result to VT */ - /* (Workspace: need 2*M, prefer M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[ iwork], &i__2, &ierr); - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - /* Generate Q in VT */ - /* (Workspace: need M + N, prefer M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], & work[iwork], &i__2, &ierr); - /* Copy L to U, zeroing out above it */ - dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); - i__2 = *m - 1; - i__3 = *m - 1; - dlaset_("U", &i__2, &i__3, &c_b57, &c_b57, &u[(u_dim1 << 1) + 1], ldu); - ie = itau; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize L in U */ - /* (Workspace: need 4*M, prefer 3*M + 2*M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, m, &u[u_offset], ldu, &s[1], &work[ie], & work[itauq], &work[itaup], &work[iwork], & i__2, &ierr); - /* Multiply right bidiagonalizing vectors in U by Q */ - /* in VT */ - /* (Workspace: need 3*M + N, prefer 3*M + N*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, & work[itaup], &vt[vt_offset], ldvt, &work[ iwork], &i__2, &ierr); - /* Generate left bidiagonalizing vectors in U */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr); - iwork = ie + *m; - /* Perform bidiagonal QR iteration, computing left */ - /* singular vectors of A in U and computing right */ - /* singular vectors of A in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, & c__1, &work[iwork], info); - } - } - } - } - else { - /* N .LT. MNTHR */ - /* Path 10t(N greater than M, but not much larger) */ - /* Reduce to bidiagonal form without LQ decomposition */ - ie = 1; - itauq = ie + *m; - itaup = itauq + *m; - iwork = itaup + *m; - /* Bidiagonalize A */ - /* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dgebrd(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], & work[itaup], &work[iwork], &i__2, &ierr); - if (wntuas) { - /* If left singular vectors desired in U, copy result to U */ - /* and generate left bidiagonalizing vectors in U */ - /* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) */ - dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu); - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[ iwork], &i__2, &ierr); - } - if (wntvas) { - /* If right singular vectors desired in VT, copy result to */ - /* VT and generate right bidiagonalizing vectors in VT */ - /* (Workspace: need 3*M + NRVT, prefer 3*M + NRVT*NB) */ - dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt); - if (wntva) { - nrvt = *n; - } - if (wntvs) { - nrvt = *m; - } - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", &nrvt, n, m, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2, &ierr); - } - if (wntuo) { - /* If left singular vectors desired in A, generate left */ - /* bidiagonalizing vectors in A */ - /* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("Q", m, m, n, &a[a_offset], lda, &work[itauq], &work[ iwork], &i__2, &ierr); - } - if (wntvo) { - /* If right singular vectors desired in A, generate right */ - /* bidiagonalizing vectors in A */ - /* (Workspace: need 4*M, prefer 3*M + M*NB) */ - i__2 = *lwork - iwork + 1; - lapack_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[ iwork], &i__2, &ierr); - } - iwork = ie + *m; - if (wntuas || wntuo) { - nru = *m; - } - if (wntun) { - nru = 0; - } - if (wntvas || wntvo) { - ncvt = *n; - } - if (wntvn) { - ncvt = 0; - } - if (! wntuo && ! wntvo) { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in U and computing right singular */ - /* vectors in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, & work[iwork], info); - } - else if (! wntuo && wntvo) { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in U and computing right singular */ - /* vectors in A */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[ a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[ iwork], info); - } - else { - /* Perform bidiagonal QR iteration, if desired, computing */ - /* left singular vectors in A and computing right singular */ - /* vectors in VT */ - /* (Workspace: need BDSPAC) */ - lapack_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[ vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, & work[iwork], info); - } - } - } - /* If lapack_dbdsqr failed to converge, copy unconverged superdiagonals */ - /* to WORK( 2:MINMN ) */ - if (*info != 0) { - if (ie > 2) { - i__2 = minmn - 1; - for (i__ = 1; - i__ <= i__2; - ++i__) { - work[i__ + 1] = work[i__ + ie - 1]; - /* L50: */ - } - } - if (ie < 2) { - for (i__ = minmn - 1; - i__ >= 1; - --i__) { - work[i__ + 1] = work[i__ + ie - 1]; - /* L60: */ - } - } - } - /* Undo scaling if necessary */ - if (iscl == 1) { - if (anrm > bignum) { - dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], & minmn, &ierr); - } - if (*info != 0 && anrm > bignum) { - i__2 = minmn - 1; - dlascl_("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &work[2], &minmn, &ierr); - } - if (anrm < smlnum) { - dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], & minmn, &ierr); - } - if (*info != 0 && anrm < smlnum) { - i__2 = minmn - 1; - dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &work[2], &minmn, &ierr); - } - } - /* Return optimal workspace in WORK(1) */ - work[1] = (doublereal) maxwrk; - return 0; - /* End of DGESVD */ - } - /* dgesvd_ */ - + if (ie < 2) { + for (i__ = minmn - 1; i__ >= 1; --i__) { + work[i__ + 1] = work[i__ + ie - 1]; + /* L60: */ + } + } + } + /* Undo scaling if necessary */ + if (iscl == 1) { + if (anrm > bignum) { + dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &minmn, + &ierr); + } + if (*info != 0 && anrm > bignum) { + i__2 = minmn - 1; + dlascl_("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &work[2], &minmn, + &ierr); + } + if (anrm < smlnum) { + dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &minmn, + &ierr); + } + if (*info != 0 && anrm < smlnum) { + i__2 = minmn - 1; + dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &work[2], &minmn, + &ierr); + } + } + /* Return optimal workspace in WORK(1) */ + work[1] = (doublereal)maxwrk; + return 0; + /* End of DGESVD */ +} +/* dgesvd_ */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorg2r.c b/src/lapack/dec/svd/ext/flamec/lapack_dorg2r.c index 894fc24fe..486ead341 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorg2r.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorg2r.c @@ -1,6 +1,12 @@ /* dorg2r.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ - #include "FLAME.h" +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + */ +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by s geqrf (unblocked algorithm). */ @@ -109,7 +115,7 @@ /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -150,7 +156,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORG2R", &i__1); + xerbla_("DORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -202,4 +208,4 @@ /* End of DORG2R */ } /* lapack_dorg2r */ - \ No newline at end of file + diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorgbr.c b/src/lapack/dec/svd/ext/flamec/lapack_dorgbr.c index f6975c7f9..7b70d2346 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorgbr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorgbr.c @@ -159,7 +159,7 @@ integer iinfo; logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), lapack_dorglq( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), lapack_dorgqr( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), lapack_dorglq( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), lapack_dorgqr( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine -- */ @@ -244,7 +244,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORGBR", &i__1); + xerbla_("DORGBR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorgl2.c b/src/lapack/dec/svd/ext/flamec/lapack_dorgl2.c index e603a6a0d..18ca256d3 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorgl2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorgl2.c @@ -1,6 +1,12 @@ /* dorgl2.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ - #include "FLAME.h" +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + */ +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #include "FLA_f2c.h" /* > \brief \b DORGL2 */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -106,7 +112,7 @@ /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -147,7 +153,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORGL2", &i__1); + xerbla_("DORGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -203,4 +209,4 @@ /* End of DORGL2 */ } /* lapack_dorgl2 */ - \ No newline at end of file + diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorglq.c b/src/lapack/dec/svd/ext/flamec/lapack_dorglq.c index 028b28bd8..1a1476530 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorglq.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorglq.c @@ -125,7 +125,7 @@ /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int lapack_dorgl2(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int lapack_dorgl2(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -178,7 +178,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORGLQ", &i__1); + xerbla_("DORGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorgqr.c b/src/lapack/dec/svd/ext/flamec/lapack_dorgqr.c index ae7a4104c..557cf3d8f 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorgqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorgqr.c @@ -126,7 +126,7 @@ /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int lapack_dorg2r(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int lapack_dorg2r(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -158,6 +158,7 @@ --work; /* Function Body */ *info = 0; + nb = 0; #ifdef FLA_ENABLE_AMD_OPT /* precomputed workspace size */ if(*n == 1){ @@ -196,7 +197,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORGQR", &i__1); + xerbla_("DORGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorm2r.c b/src/lapack/dec/svd/ext/flamec/lapack_dorm2r.c index 81fcc617d..3cffd2e9b 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorm2r.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorm2r.c @@ -159,7 +159,7 @@ int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -224,7 +224,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("lapack_dorm2r", &i__1); + xerbla_("lapack_dorm2r", &i__1, (ftnlen)13); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dormbr.c b/src/lapack/dec/svd/ext/flamec/lapack_dormbr.c index e3b4830b7..6eaa14b2f 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dormbr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dormbr.c @@ -4,7 +4,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; - static integer c__2 = 2; /* > \brief \b DORMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -194,8 +193,7 @@ /* Subroutine */ int lapack_dormbr(char *vect, char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -206,7 +204,7 @@ extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int lapack_dormlq(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -321,7 +319,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORMBR", &i__1); + xerbla_("DORMBR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dorml2.c b/src/lapack/dec/svd/ext/flamec/lapack_dorml2.c index 625bb848a..7943ec4a0 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dorml2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dorml2.c @@ -156,7 +156,7 @@ int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -221,7 +221,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORML2", &i__1); + xerbla_("DORML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dormlq.c b/src/lapack/dec/svd/ext/flamec/lapack_dormlq.c index 15dbf8086..88c7e0e77 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dormlq.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dormlq.c @@ -168,8 +168,7 @@ the routine */ /* Subroutine */ int lapack_dormlq(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -180,7 +179,7 @@ int lapack_dormlq(char *side, char *trans, integer *m, integer *n, integer *k, d extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int lapack_dorml2(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int lapack_dorml2(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -271,7 +270,7 @@ int lapack_dormlq(char *side, char *trans, integer *m, integer *n, integer *k, d } if (*info != 0) { i__1 = -(*info); - xerbla_("DORMLQ", &i__1); + xerbla_("DORMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_dormqr.c b/src/lapack/dec/svd/ext/flamec/lapack_dormqr.c index d96297f37..77d0943cb 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_dormqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_dormqr.c @@ -169,8 +169,7 @@ the routine */ /* Subroutine */ int lapack_dormqr(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -181,7 +180,7 @@ int lapack_dormqr(char *side, char *trans, integer *m, integer *n, integer *k, d extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int lapack_dorm2r(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int lapack_dorm2r(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -270,7 +269,7 @@ int lapack_dormqr(char *side, char *trans, integer *m, integer *n, integer *k, d } if (*info != 0) { i__1 = -(*info); - xerbla_("DORMQR", &i__1); + xerbla_("DORMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sbdsqr.c b/src/lapack/dec/svd/ext/flamec/lapack_sbdsqr.c index 229ede113..34f23bd34 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sbdsqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sbdsqr.c @@ -276,7 +276,7 @@ int lapack_sbdsqr(char *uplo, integer *n, integer *ncvt, integer * nru, integer real sn, mu; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real sminoa; extern /* Subroutine */ int slartg_(real *, real *, real *, real *, real * ); @@ -357,7 +357,7 @@ int lapack_sbdsqr(char *uplo, integer *n, integer *ncvt, integer * nru, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SBDSQR", &i__1); + xerbla_("SBDSQR", &i__1, (ftnlen)6); return 0; } if (*n == 0) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgebd2.c b/src/lapack/dec/svd/ext/flamec/lapack_sgebd2.c index f485ccdac..73fa0aff1 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgebd2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgebd2.c @@ -193,7 +193,7 @@ int lapack_sgebd2(integer *m, integer *n, real *a, integer *lda, real *d__, real /* Local variables */ integer i__; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -238,7 +238,7 @@ int lapack_sgebd2(integer *m, integer *n, real *a, integer *lda, real *d__, real if (*info < 0) { i__1 = -(*info); - xerbla_("SGEBD2", &i__1); + xerbla_("SGEBD2", &i__1, (ftnlen)6); return 0; } if (*m >= *n) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgebrd.c b/src/lapack/dec/svd/ext/flamec/lapack_sgebrd.c index a404479f5..b923ea73f 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgebrd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgebrd.c @@ -4,8 +4,6 @@ static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; -static real c_b21 = -1.f; -static real c_b22 = 1.f; /* > \brief \b SGEBRD */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -210,9 +208,9 @@ the routine */ int lapack_sgebrd(integer *m, integer *n, real *a, integer *lda, real *d__, real *e, real *tauq, real *taup, real *work, integer * lwork, integer *info) { /* System generated locals */ - integer a_dim1, a_offset, i__1, i__2, i__3, i__4; + integer a_dim1, a_offset, i__1, i__2; /* Local variables */ - integer i__, j, nbmin, iinfo; + integer i__, nbmin, iinfo; extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); integer minmn; @@ -223,9 +221,9 @@ int lapack_sgebrd(integer *m, integer *n, real *a, integer *lda, real *d__, real int slabrd_(integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *); integer ws; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); - integer ldwrkx, ldwrky, lwkopt; + integer lwkopt; logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -289,7 +287,7 @@ int lapack_sgebrd(integer *m, integer *n, real *a, integer *lda, real *d__, real if (*info < 0) { i__1 = -(*info); - xerbla_("SGEBRD", &i__1); + xerbla_("SGEBRD", &i__1, (ftnlen)6); return 0; } else if (lquery) @@ -304,8 +302,6 @@ int lapack_sgebrd(integer *m, integer *n, real *a, integer *lda, real *d__, real return 0; } ws = fla_max(*m,*n); - ldwrkx = *m; - ldwrky = *n; if (nb > 1 && nb < minmn) { /* Set the crossover point NX. */ @@ -345,7 +341,13 @@ int lapack_sgebrd(integer *m, integer *n, real *a, integer *lda, real *d__, real /* Current blocked algorithm has accuracy issue, so unblocked algorithm is enabled by default Todo: This is a temporary workaround until the issue in the blocked algorithm is fixed. */ -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT + integer ldwrkx, ldwrky, j, i__4, i__3; + static real c_b22 = 1.f; + static real c_b21 = -1.f; + ldwrkx = *m; + ldwrky = *n; + for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgelq2.c b/src/lapack/dec/svd/ext/flamec/lapack_sgelq2.c index 87a4e2136..9d9075eec 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgelq2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgelq2.c @@ -124,7 +124,7 @@ int lapack_sgelq2(integer *m, integer *n, real *a, integer *lda, real *tau, real /* Local variables */ integer i__, k; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); real aii; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -167,7 +167,7 @@ int lapack_sgelq2(integer *m, integer *n, real *a, integer *lda, real *tau, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQ2", &i__1); + xerbla_("SGELQ2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgelqf.c b/src/lapack/dec/svd/ext/flamec/lapack_sgelqf.c index 55e61ca68..3b8d66e9e 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgelqf.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgelqf.c @@ -147,7 +147,7 @@ int lapack_sgelqf(integer *m, integer *n, real *a, integer *lda, real *tau, real int lapack_sgelq2(integer *, integer *, real *, integer *, real *, real *, integer *); integer ib, nb, nx; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -203,7 +203,7 @@ int lapack_sgelqf(integer *m, integer *n, real *a, integer *lda, real *tau, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQF", &i__1); + xerbla_("SGELQF", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgesdd.c b/src/lapack/dec/svd/ext/flamec/lapack_sgesdd.c index 2e3aa60de..c09f4457d 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgesdd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgesdd.c @@ -243,15 +243,14 @@ int lapack_sgesdd(char *jobz, integer *m, integer *n, real *a, integer *lda, rea logical wntqa; integer nwork; logical wntqn, wntqo, wntqs; - integer ie, il, ir, bdspac, iu, lwork_sorgbr_p_mm__; + integer ie, il, ir, bdspac, iu; extern /* Subroutine */ int sbdsdc_(char *, char *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); - integer lwork_sorgbr_q_nn__; extern /* Subroutine */ int lapack_sgebrd(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int sgelqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -376,7 +375,6 @@ int lapack_sgesdd(char *jobz, integer *m, integer *n, real *a, integer *lda, rea sgeqrf_(m, n, dum, m, dum, dum, &c_n1, &ierr); lwork_sgeqrf_mn__ = (integer) dum[0]; sorgbr_("Q", n, n, n, dum, n, dum, dum, &c_n1, &ierr); - lwork_sorgbr_q_nn__ = (integer) dum[0]; sorgqr_(m, m, n, dum, m, dum, dum, &c_n1, &ierr); lwork_sorgqr_mm__ = (integer) dum[0]; sorgqr_(m, n, n, dum, m, dum, dum, &c_n1, &ierr); @@ -585,7 +583,6 @@ int lapack_sgesdd(char *jobz, integer *m, integer *n, real *a, integer *lda, rea sorglq_(m, n, m, &a[a_offset], m, dum, dum, &c_n1, &ierr); lwork_sorglq_mn__ = (integer) dum[0]; sorgbr_("P", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr); - lwork_sorgbr_p_mm__ = (integer) dum[0]; lapack_sormbr("P", "R", "T", m, m, m, dum, m, dum, dum, m, dum, &c_n1, & ierr); lwork_sormbr_prt_mm__ = (integer) dum[0]; lapack_sormbr("P", "R", "T", m, n, m, dum, m, dum, dum, m, dum, &c_n1, & ierr); @@ -775,7 +772,7 @@ int lapack_sgesdd(char *jobz, integer *m, integer *n, real *a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SGESDD", &i__1); + xerbla_("SGESDD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sgesvd.c b/src/lapack/dec/svd/ext/flamec/lapack_sgesvd.c index d235486eb..b6515e2d7 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sgesvd.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sgesvd.c @@ -2,7 +2,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c_n1 = -1; static real c_b57 = 0.f; static integer c__1 = 1; @@ -222,8 +221,7 @@ the routine */ int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, integer *lda, real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -244,7 +242,7 @@ int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, inte int lapack_sgebrd(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -307,6 +305,10 @@ int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, inte wntvo = lsame_(jobvt, "O"); wntvn = lsame_(jobvt, "N"); lquery = *lwork == -1; + ie = 0; + bdspac = 0; + mnthr = 0; + wrkbl = 0; if (! (wntua || wntus || wntuo || wntun)) { *info = -1; @@ -931,7 +933,7 @@ int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, inte if (*info != 0) { i__2 = -(*info); - xerbla_("SGESVD", &i__2); + xerbla_("SGESVD", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorg2r.c b/src/lapack/dec/svd/ext/flamec/lapack_sorg2r.c index a7649cb56..8c386434a 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorg2r.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorg2r.c @@ -108,7 +108,7 @@ int lapack_sorg2r(integer *m, integer *n, integer *k, real *a, integer *lda, rea /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int lapack_sorg2r(integer *m, integer *n, integer *k, real *a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORG2R", &i__1); + xerbla_("SORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorgbr.c b/src/lapack/dec/svd/ext/flamec/lapack_sorgbr.c index f260a994c..ccf1d6d45 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorgbr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorgbr.c @@ -159,7 +159,7 @@ int lapack_sorgbr(char *vect, integer *m, integer *n, integer *k, real *a, integ logical wantq; integer mn; extern /* Subroutine */ - int xerbla_(char *, integer *), lapack_sorglq( integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), lapack_sorgqr(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), lapack_sorglq( integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), lapack_sorgqr(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine -- */ @@ -260,7 +260,7 @@ int lapack_sorgbr(char *vect, integer *m, integer *n, integer *k, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SORGBR", &i__1); + xerbla_("SORGBR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorgl2.c b/src/lapack/dec/svd/ext/flamec/lapack_sorgl2.c index bc2c21862..875896c19 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorgl2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorgl2.c @@ -105,7 +105,7 @@ int lapack_sorgl2(integer *m, integer *n, integer *k, real *a, integer *lda, rea /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -151,7 +151,7 @@ int lapack_sorgl2(integer *m, integer *n, integer *k, real *a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORGL2", &i__1); + xerbla_("SORGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorglq.c b/src/lapack/dec/svd/ext/flamec/lapack_sorglq.c index 85abe7e90..f9e004d40 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorglq.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorglq.c @@ -127,7 +127,7 @@ int lapack_sorglq(integer *m, integer *n, integer *k, real *a, integer *lda, rea int lapack_sorgl2(integer *, integer *, integer *, real *, integer *, real *, real *, integer *); integer ib, nb, ki, kk, nx; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -189,7 +189,7 @@ int lapack_sorglq(integer *m, integer *n, integer *k, real *a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORGLQ", &i__1); + xerbla_("SORGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorgqr.c b/src/lapack/dec/svd/ext/flamec/lapack_sorgqr.c index 3fb660043..883e11235 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorgqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorgqr.c @@ -128,7 +128,7 @@ int lapack_sorgqr(integer *m, integer *n, integer *k, real *a, integer *lda, rea int lapack_sorg2r(integer *, integer *, integer *, real *, integer *, real *, real *, integer *); integer nb, ki, kk, nx; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -190,7 +190,7 @@ int lapack_sorgqr(integer *m, integer *n, integer *k, real *a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORGQR", &i__1); + xerbla_("SORGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorm2r.c b/src/lapack/dec/svd/ext/flamec/lapack_sorm2r.c index f1bbb9d79..3efed8af8 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorm2r.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorm2r.c @@ -158,7 +158,7 @@ int lapack_sorm2r(char *side, char *trans, integer *m, integer *n, integer *k, r int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *); integer i1, i2, i3, ic, jc, mi, ni, nq; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; real aii; /* -- LAPACK computational routine -- */ @@ -234,7 +234,7 @@ int lapack_sorm2r(char *side, char *trans, integer *m, integer *n, integer *k, r if (*info != 0) { i__1 = -(*info); - xerbla_("SORM2R", &i__1); + xerbla_("SORM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sormbr.c b/src/lapack/dec/svd/ext/flamec/lapack_sormbr.c index 416fa2440..44c3484df 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sormbr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sormbr.c @@ -5,7 +5,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b SORMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -197,8 +196,7 @@ the routine */ int lapack_sormbr(char *vect, char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -208,7 +206,7 @@ int lapack_sormbr(char *vect, char *side, char *trans, integer *m, integer *n, i extern logical lsame_(char *, char *); integer iinfo, i1, i2, nb, mi, ni, nq, nw; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran, applyq; char transt[1]; @@ -342,7 +340,7 @@ int lapack_sormbr(char *vect, char *side, char *trans, integer *m, integer *n, i if (*info != 0) { i__1 = -(*info); - xerbla_("SORMBR", &i__1); + xerbla_("SORMBR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sorml2.c b/src/lapack/dec/svd/ext/flamec/lapack_sorml2.c index 3f5f70d33..fc53e62a5 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sorml2.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sorml2.c @@ -155,7 +155,7 @@ int lapack_sorml2(char *side, char *trans, integer *m, integer *n, integer *k, r int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *); integer i1, i2, i3, ic, jc, mi, ni, nq; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; real aii; /* -- LAPACK computational routine -- */ @@ -231,7 +231,7 @@ int lapack_sorml2(char *side, char *trans, integer *m, integer *n, integer *k, r if (*info != 0) { i__1 = -(*info); - xerbla_("SORML2", &i__1); + xerbla_("SORML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sormlq.c b/src/lapack/dec/svd/ext/flamec/lapack_sormlq.c index 5bb23b48f..90a92396f 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sormlq.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sormlq.c @@ -168,8 +168,7 @@ the routine */ int lapack_sormlq(char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -183,7 +182,7 @@ int lapack_sormlq(char *side, char *trans, integer *m, integer *n, integer *k, r int lapack_sorml2(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *); integer nb, mi, ni, nq, nw; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -289,7 +288,7 @@ int lapack_sormlq(char *side, char *trans, integer *m, integer *n, integer *k, r if (*info != 0) { i__1 = -(*info); - xerbla_("SORMLQ", &i__1); + xerbla_("SORMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/svd/ext/flamec/lapack_sormqr.c b/src/lapack/dec/svd/ext/flamec/lapack_sormqr.c index 7863849ea..945860d84 100644 --- a/src/lapack/dec/svd/ext/flamec/lapack_sormqr.c +++ b/src/lapack/dec/svd/ext/flamec/lapack_sormqr.c @@ -169,8 +169,7 @@ the routine */ int lapack_sormqr(char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -184,7 +183,7 @@ int lapack_sormqr(char *side, char *trans, integer *m, integer *n, integer *k, r int lapack_sorm2r(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *); integer mi, ni, nq, nw; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -288,7 +287,7 @@ int lapack_sormqr(char *side, char *trans, integer *m, integer *n, integer *k, r if (*info != 0) { i__1 = -(*info); - xerbla_("SORMQR", &i__1); + xerbla_("SORMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/lapack/dec/tevd/n/flamec/FLA_Tevd_francis_n_opt_var1.c b/src/lapack/dec/tevd/n/flamec/FLA_Tevd_francis_n_opt_var1.c index 208d771b7..ae0f6e14c 100644 --- a/src/lapack/dec/tevd/n/flamec/FLA_Tevd_francis_n_opt_var1.c +++ b/src/lapack/dec/tevd/n/flamec/FLA_Tevd_francis_n_opt_var1.c @@ -186,14 +186,14 @@ FLA_Error FLA_Tevd_francis_n_opd_var1( integer m_A, printf( "FLA_Tevd_francis_n_opt_var1: bulge disappeared!\n" ); if ( MAC_Tevd_eigval_converged2_opd( eps2, safmin, *alpha11, *alpha21, *alpha22 ) ) { - printf( "FLA_Tevd_francis_n_opt_var1: deflation detected (col %d)\n", i ); + printf( "FLA_Tevd_francis_n_opt_var1: deflation detected (col %d)\n", (int) i ); printf( "FLA_Tevd_francis_n_opt_var1: alpha11 = %23.19e\n", *alpha11 ); printf( "FLA_Tevd_francis_n_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 ); return i; } else { - printf( "FLA_Tevd_francis_n_opt_var1: but NO deflation detected! (col %d)\n", i ); + printf( "FLA_Tevd_francis_n_opt_var1: but NO deflation detected! (col %d)\n", (int) i ); printf( "FLA_Tevd_francis_n_opt_var1: alpha11 = %23.19e\n", *alpha11 ); printf( "FLA_Tevd_francis_n_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 ); FLA_Abort(); diff --git a/src/lapack/dec/tevd/n/flamec/FLA_Tevd_n_opt_var1.c b/src/lapack/dec/tevd/n/flamec/FLA_Tevd_n_opt_var1.c index 917bafc13..55cd51d9b 100644 --- a/src/lapack/dec/tevd/n/flamec/FLA_Tevd_n_opt_var1.c +++ b/src/lapack/dec/tevd/n/flamec/FLA_Tevd_n_opt_var1.c @@ -1,213 +1,172 @@ /* - Copyright (C) 2014, The University of Texas at Austin + Copyright (C) 2014, The University of Texas at Austin - This file is part of libflame and is available under the 3-Clause - BSD license, which can be found in the LICENSE file at the top-level - directory, or at http://opensource.org/licenses/BSD-3-Clause + This file is part of libflame and is available under the 3-Clause + BSD license, which can be found in the LICENSE file at the top-level + directory, or at http://opensource.org/licenses/BSD-3-Clause */ #include "FLAME.h" -FLA_Error FLA_Tevd_n_opt_var1( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj U ) +FLA_Error FLA_Tevd_n_opt_var1(dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj U) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype datatype; - integer m_A, m_U, n_G; - integer inc_d; - integer inc_e; - integer rs_G, cs_G; + integer m_A, m_U, n_G; + integer inc_d; + integer inc_e; + integer rs_G, cs_G; - datatype = FLA_Obj_datatype( U ); + datatype = FLA_Obj_datatype(U); - m_A = FLA_Obj_vector_dim( d ); - m_U = FLA_Obj_vector_dim( d ); - n_G = FLA_Obj_width( G ); + m_A = FLA_Obj_vector_dim(d); + m_U = FLA_Obj_vector_dim(d); + n_G = FLA_Obj_width(G); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - - rs_G = FLA_Obj_row_stride( G ); - cs_G = FLA_Obj_col_stride( G ); + inc_d = FLA_Obj_vector_inc(d); + inc_e = FLA_Obj_vector_inc(e); -/* -FLA_Obj de, deL, deR, deLT, deLB; -FLA_Obj_create( FLA_DOUBLE, m_A, 2, 0, 0, &de ); -FLA_Part_1x2( de, &deL, &deR, 1, FLA_LEFT ); -FLA_Part_2x1( deL, &deLT, - &deLB, 1, FLA_BOTTOM ); -FLA_Copy( d, deR ); -FLA_Copy( e, deLT ); -FLA_Set( FLA_ZERO, deLB ); -//FLA_Obj_show( "de", de, "%21.17e", "" ); -*/ + rs_G = FLA_Obj_row_stride(G); + cs_G = FLA_Obj_col_stride(G); - switch ( datatype ) + switch (datatype) { - case FLA_FLOAT: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - - r_val = FLA_Tevd_n_ops_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G ); - - break; - } + case FLA_FLOAT: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + + r_val = FLA_Tevd_n_ops_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G); + + break; + } - case FLA_DOUBLE: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - - r_val = FLA_Tevd_n_opd_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G ); - - break; - } + case FLA_DOUBLE: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + + r_val = FLA_Tevd_n_opd_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G); + + break; + } - case FLA_COMPLEX: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - - r_val = FLA_Tevd_n_opc_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G ); - - break; - } + case FLA_COMPLEX: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + + r_val = FLA_Tevd_n_opc_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G); + + break; + } - case FLA_DOUBLE_COMPLEX: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - - r_val = FLA_Tevd_n_opz_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G ); - - break; - } + case FLA_DOUBLE_COMPLEX: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + + r_val = FLA_Tevd_n_opz_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G); + + break; } -/* -FLA_Copy( d, deR ); -FLA_Copy( e, deLT ); -FLA_Set( FLA_ZERO, deLB ); -FLA_Sort( FLA_FORWARD, deR ); -FLA_Obj_show( "de after", de, "%21.17e", "" ); -double eps = FLA_Mach_params_opd( FLA_MACH_EPS ); -printf( "epsilon = %21.17e\n", eps ); -FLA_Obj_free( &de ); -*/ + } + return r_val; } - - -FLA_Error FLA_Tevd_n_ops_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G ) +FLA_Error FLA_Tevd_n_ops_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G) { return FLA_SUCCESS; } - - -FLA_Error FLA_Tevd_n_opd_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G ) +FLA_Error FLA_Tevd_n_opd_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G) { return FLA_SUCCESS; } -FLA_Error FLA_Tevd_n_opc_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G ) +FLA_Error FLA_Tevd_n_opc_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G) { return FLA_SUCCESS; } -//#define PRINTF - -FLA_Error FLA_Tevd_n_opz_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G ) +FLA_Error FLA_Tevd_n_opz_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G) { - dcomplex one = bl1_z1(); - double rone = bl1_d1(); - - double eps; - double eps2; - double safmin; - double ssfmin; - double safmax; - double ssfmax; - - dcomplex* G; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_G_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; - - // Initialize some numerical constants. - eps = FLA_Mach_params_opd( FLA_MACH_EPS ); - eps2 = FLA_Mach_params_opd( FLA_MACH_EPS2 ); - safmin = FLA_Mach_params_opd( FLA_MACH_SFMIN ); - safmax = rone / safmin; - ssfmax = sqrt( safmax ) / 3.0; - ssfmin = sqrt( safmin ) / eps2; - - // Initialize our completion flag. - done = FALSE; + dcomplex one = bl1_z1(); + double *d1; + double *e1; + integer r_val; + integer done; + integer m_G_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_iter_prev; + integer n_iter_perf_sweep_max; + +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0 +#endif + + // Initialize our completion flag. + done = FALSE; // Initialize a counter that holds the maximum number of rows of G // that we would need to initialize for the next sweep. @@ -217,14 +176,14 @@ FLA_Error FLA_Tevd_n_opz_var1( integer m_A, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G to contain only identity rotations. - bl1_zsetm( m_G_sweep_max, - n_G, - &one, - buff_G, rs_G, cs_G ); + bl1_zsetm(m_G_sweep_max, + n_G, + &one, + buff_G, rs_G, cs_G); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -234,12 +193,12 @@ FLA_Error FLA_Tevd_n_opz_var1( integer m_A, // Perform a sweep: Move through the matrix and perform a tridiagonal // EVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be m_A - 1. - for ( ij_begin = 0; ij_begin < m_A; ) + for (ij_begin = 0; ij_begin < m_A;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Tevd_n_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Tevd_n_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -249,12 +208,12 @@ printf( "FLA_Tevd_n_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // subdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Tevd_find_submatrix_opd( m_A, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Tevd_find_submatrix_opd(m_A, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -262,13 +221,13 @@ printf( "FLA_Tevd_n_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Tevd_n_opz_var1: subdiagonal is completely zero.\n" ); -printf( "FLA_Tevd_n_opz_var1: Francis iteration is done!\n" ); + printf("FLA_Tevd_n_opz_var1: subdiagonal is completely zero.\n"); + printf("FLA_Tevd_n_opz_var1: Francis iteration is done!\n"); #endif done = TRUE; } @@ -290,10 +249,10 @@ printf( "FLA_Tevd_n_opz_var1: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Tevd_n_opz_var1: ij_begin = %d\n", ij_begin ); -printf( "FLA_Tevd_n_opz_var1: ijTL = %d\n", ijTL ); -printf( "FLA_Tevd_n_opz_var1: ijBR = %d\n", ijBR ); -printf( "FLA_Tevd_n_opz_var1: m_A11 = %d\n", m_A11 ); + printf("FLA_Tevd_n_opz_var1: ij_begin = %d\n", ij_begin); + printf("FLA_Tevd_n_opz_var1: ijTL = %d\n", ijTL); + printf("FLA_Tevd_n_opz_var1: ijBR = %d\n", ijBR); + printf("FLA_Tevd_n_opz_var1: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -303,17 +262,16 @@ printf( "FLA_Tevd_n_opz_var1: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; // Compute the 1-norm (which equals the infinity norm since the // matrix is tridiagonal and symmetric) and perform appropriate // scaling if necessary. -/* - FLA_Norm1_tridiag( m_A11, - d1, inc_d, - e1, inc_e, - &norm ); -*/ + /* + FLA_Norm1_tridiag( m_A11, + d1, inc_d, + e1, inc_e, + &norm ); + */ // Search for a batch of eigenvalues, recursing on deflated // subproblems whenever a split occurs. Iteration continues @@ -323,24 +281,31 @@ printf( "FLA_Tevd_n_opz_var1: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Tevd_iteracc_n_opd_var1( m_A11, - n_G, - ijTL, - d1, inc_d, - e1, inc_e, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Tevd_iteracc_n_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + &n_iter_perf); // Record the number of deflations that were observed. total_deflations += n_deflations; - +#else + FLA_Tevd_iteracc_n_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Tevd_n_opz_var1: deflations observed = %d\n", n_deflations ); -printf( "FLA_Tevd_n_opz_var1: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Tevd_n_opz_var1: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Tevd_n_opz_var1: deflations observed = %d\n", n_deflations); + printf("FLA_Tevd_n_opz_var1: total deflations observed = %d\n", total_deflations); + printf("FLA_Tevd_n_opz_var1: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -351,13 +316,13 @@ printf( "FLA_Tevd_n_opz_var1: num iterations performed = %d\n", n_iter_perf ); m_G_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= m_A * n_iter_max ) + if (n_iter_prev >= m_A * n_iter_max) { #ifdef PRINTF -printf( "FLA_Tevd_n_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Tevd_n_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -367,11 +332,10 @@ printf( "FLA_Tevd_n_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF -printf( "FLA_Tevd_n_opz_var1: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Tevd_n_opz_var1: total number of iterations performed: %d\n", n_iter_prev); #endif } - //return FLA_SUCCESS; + // return FLA_SUCCESS; return n_iter_prev; } - diff --git a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_francis_v_opt_var1.c b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_francis_v_opt_var1.c index b6cf50efb..845f6627d 100644 --- a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_francis_v_opt_var1.c +++ b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_francis_v_opt_var1.c @@ -195,14 +195,14 @@ FLA_Error FLA_Tevd_francis_v_opd_var1( integer m_A, printf( "FLA_Tevd_francis_v_opt_var1: bulge disappeared!\n" ); if ( MAC_Tevd_eigval_converged_opd( eps, safmin, *alpha11, *alpha21, *alpha22 ) ) { - printf( "FLA_Tevd_francis_v_opt_var1: deflation detected (col %d)\n", i ); + printf( "FLA_Tevd_francis_v_opt_var1: deflation detected (col %d)\n", (int) i ); printf( "FLA_Tevd_francis_v_opt_var1: alpha11 = %23.19e\n", *alpha11 ); printf( "FLA_Tevd_francis_v_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 ); return i; } else { - printf( "FLA_Tevd_francis_v_opt_var1: but NO deflation detected! (col %d)\n", i ); + printf( "FLA_Tevd_francis_v_opt_var1: but NO deflation detected! (col %d)\n", (int) i ); printf( "FLA_Tevd_francis_v_opt_var1: alpha11 = %23.19e\n", *alpha11 ); printf( "FLA_Tevd_francis_v_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 ); FLA_Abort(); diff --git a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var1.c b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var1.c index 7fbc717cb..3a56b9167 100644 --- a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var1.c +++ b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var1.c @@ -1,176 +1,176 @@ /* - Copyright (C) 2014, The University of Texas at Austin + Copyright (C) 2014, The University of Texas at Austin - This file is part of libflame and is available under the 3-Clause - BSD license, which can be found in the LICENSE file at the top-level - directory, or at http://opensource.org/licenses/BSD-3-Clause + This file is part of libflame and is available under the 3-Clause + BSD license, which can be found in the LICENSE file at the top-level + directory, or at http://opensource.org/licenses/BSD-3-Clause */ #include "FLAME.h" -FLA_Error FLA_Tevd_v_opt_var1( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj U, dim_t b_alg ) +FLA_Error FLA_Tevd_v_opt_var1(dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj U, dim_t b_alg) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype datatype; - integer m_A, m_U, n_G; - integer inc_d; - integer inc_e; - integer rs_G, cs_G; - integer rs_U, cs_U; + integer m_A, m_U, n_G; + integer inc_d; + integer inc_e; + integer rs_G, cs_G; + integer rs_U, cs_U; - datatype = FLA_Obj_datatype( U ); + datatype = FLA_Obj_datatype(U); - m_A = FLA_Obj_vector_dim( d ); - m_U = FLA_Obj_length( U ); - n_G = FLA_Obj_width( G ); + m_A = FLA_Obj_vector_dim(d); + m_U = FLA_Obj_length(U); + n_G = FLA_Obj_width(G); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - - rs_G = FLA_Obj_row_stride( G ); - cs_G = FLA_Obj_col_stride( G ); + inc_d = FLA_Obj_vector_inc(d); + inc_e = FLA_Obj_vector_inc(e); - rs_U = FLA_Obj_row_stride( U ); - cs_U = FLA_Obj_col_stride( U ); + rs_G = FLA_Obj_row_stride(G); + cs_G = FLA_Obj_col_stride(G); + rs_U = FLA_Obj_row_stride(U); + cs_U = FLA_Obj_col_stride(U); - switch ( datatype ) + switch (datatype) { - case FLA_FLOAT: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - float* buff_U = FLA_FLOAT_PTR( U ); - - r_val = FLA_Tevd_v_ops_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_FLOAT: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + float *buff_U = FLA_FLOAT_PTR(U); + + r_val = FLA_Tevd_v_ops_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_DOUBLE: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - double* buff_U = FLA_DOUBLE_PTR( U ); - - r_val = FLA_Tevd_v_opd_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_DOUBLE: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + double *buff_U = FLA_DOUBLE_PTR(U); + + r_val = FLA_Tevd_v_opd_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_COMPLEX: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - scomplex* buff_U = FLA_COMPLEX_PTR( U ); - - r_val = FLA_Tevd_v_opc_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_COMPLEX: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + scomplex *buff_U = FLA_COMPLEX_PTR(U); + + r_val = FLA_Tevd_v_opc_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_DOUBLE_COMPLEX: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - dcomplex* buff_U = FLA_DOUBLE_COMPLEX_PTR( U ); - - r_val = FLA_Tevd_v_opz_var1( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_DOUBLE_COMPLEX: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + dcomplex *buff_U = FLA_DOUBLE_COMPLEX_PTR(U); + + r_val = FLA_Tevd_v_opz_var1(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); + + break; + } } return r_val; } - - -FLA_Error FLA_Tevd_v_ops_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - float* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_ops_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + float *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } -//#define PRINTF - -FLA_Error FLA_Tevd_v_opd_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - double* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +// #define PRINTF + +FLA_Error FLA_Tevd_v_opd_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + double *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - dcomplex one = bl1_z1(); - - dcomplex* G; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_G_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_U_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + + dcomplex *G; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_G_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_U_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; - // Initialize our completion flag. - done = FALSE; +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0 +#endif + // Initialize our completion flag. + done = FALSE; // Initialize a counter that holds the maximum number of rows of G // that we would need to initialize for the next sweep. @@ -180,13 +180,13 @@ FLA_Error FLA_Tevd_v_opd_var1( integer m_A, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G to contain only identity rotations. - bl1_zsetm( m_G_sweep_max, - n_G, - &one, - buff_G, rs_G, cs_G ); + bl1_zsetm(m_G_sweep_max, + n_G, + &one, + buff_G, rs_G, cs_G); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -196,12 +196,12 @@ FLA_Error FLA_Tevd_v_opd_var1( integer m_A, // Perform a sweep: Move through the matrix and perform a tridiagonal // EVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be m_A - 1. - for ( ij_begin = 0; ij_begin < m_A; ) + for (ij_begin = 0; ij_begin < m_A;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Tevd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Tevd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -211,12 +211,12 @@ printf( "FLA_Tevd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // subdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Tevd_find_submatrix_opd( m_A, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Tevd_find_submatrix_opd(m_A, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -224,13 +224,13 @@ printf( "FLA_Tevd_v_opd_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: subdiagonal is completely zero.\n" ); -printf( "FLA_Tevd_v_opd_var1: Francis iteration is done!\n" ); + printf("FLA_Tevd_v_opd_var1: subdiagonal is completely zero.\n"); + printf("FLA_Tevd_v_opd_var1: Francis iteration is done!\n"); #endif done = TRUE; } @@ -252,10 +252,10 @@ printf( "FLA_Tevd_v_opd_var1: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: ij_begin = %d\n", ij_begin ); -printf( "FLA_Tevd_v_opd_var1: ijTL = %d\n", ijTL ); -printf( "FLA_Tevd_v_opd_var1: ijBR = %d\n", ijBR ); -printf( "FLA_Tevd_v_opd_var1: m_A11 = %d\n", m_A11 ); + printf("FLA_Tevd_v_opd_var1: ij_begin = %d\n", ij_begin); + printf("FLA_Tevd_v_opd_var1: ijTL = %d\n", ijTL); + printf("FLA_Tevd_v_opd_var1: ijBR = %d\n", ijBR); + printf("FLA_Tevd_v_opd_var1: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -265,7 +265,7 @@ printf( "FLA_Tevd_v_opd_var1: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; + G = buff_G + ijTL * rs_G; // Search for a batch of eigenvalues, recursing on deflated // subproblems whenever a split occurs. Iteration continues @@ -275,25 +275,33 @@ printf( "FLA_Tevd_v_opd_var1: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Tevd_iteracc_v_opd_var1( m_A11, - n_G, - ijTL, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); // Record the number of deflations that were observed. total_deflations += n_deflations; - +#else + FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: deflations observed = %d\n", n_deflations ); -printf( "FLA_Tevd_v_opd_var1: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Tevd_v_opd_var1: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Tevd_v_opd_var1: deflations observed = %d\n", n_deflations); + printf("FLA_Tevd_v_opd_var1: total deflations observed = %d\n", total_deflations); + printf("FLA_Tevd_v_opd_var1: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -304,13 +312,13 @@ printf( "FLA_Tevd_v_opd_var1: num iterations performed = %d\n", n_iter_perf ); m_G_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= m_A * n_iter_max ) + if (n_iter_prev >= m_A * n_iter_max) { #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opd_var1: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -322,7 +330,7 @@ printf( "FLA_Tevd_v_opd_var1: reached maximum total number of iterations: %d\n", n_U_apply = m_G_sweep_max + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); + printf("FLA_Tevd_v_opd_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); #endif // Apply the Givens rotations. Note that we optimize the scope @@ -338,73 +346,74 @@ printf( "FLA_Tevd_v_opd_var1: applying %d sets of Givens rotations\n", n_iter_pe // Similar to above, we could simply always perform the // application on all m_A columns of A, but instead we apply // only to the first n_U_apply columns to save time. - //FLA_Apply_G_rf_bld_var1( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var2( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, - m_U, - n_U_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); - - + // FLA_Apply_G_rf_bld_var1( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var2( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6( n_iter_perf_sweep_max, + m_U, + n_U_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var1: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opd_var1: total number of iterations performed: %d\n", n_iter_prev); #endif } return n_iter_prev; } -FLA_Error FLA_Tevd_v_opc_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - scomplex* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_opc_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + scomplex *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } -FLA_Error FLA_Tevd_v_opz_var1( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - dcomplex* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_opz_var1(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + dcomplex *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - dcomplex one = bl1_z1(); - - dcomplex* G; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_G_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_U_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + + dcomplex *G; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_G_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_U_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0; +#endif // Initialize our completion flag. done = FALSE; @@ -416,14 +425,14 @@ FLA_Error FLA_Tevd_v_opz_var1( integer m_A, n_iter_prev = 0; // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G to contain only identity rotations. - bl1_zsetm( m_G_sweep_max, - n_G, - &one, - buff_G, rs_G, cs_G ); + bl1_zsetm(m_G_sweep_max, + n_G, + &one, + buff_G, rs_G, cs_G); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -433,12 +442,12 @@ FLA_Error FLA_Tevd_v_opz_var1( integer m_A, // Perform a sweep: Move through the matrix and perform a tridiagonal // EVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be m_A - 1. - for ( ij_begin = 0; ij_begin < m_A; ) + for (ij_begin = 0; ij_begin < m_A;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Tevd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Tevd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -448,12 +457,12 @@ printf( "FLA_Tevd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // subdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Tevd_find_submatrix_opd( m_A, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Tevd_find_submatrix_opd(m_A, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -461,13 +470,13 @@ printf( "FLA_Tevd_v_opz_var1: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: subdiagonal is completely zero.\n" ); -printf( "FLA_Tevd_v_opz_var1: Francis iteration is done!\n" ); + printf("FLA_Tevd_v_opz_var1: subdiagonal is completely zero.\n"); + printf("FLA_Tevd_v_opz_var1: Francis iteration is done!\n"); #endif done = TRUE; } @@ -489,10 +498,10 @@ printf( "FLA_Tevd_v_opz_var1: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: ij_begin = %d\n", ij_begin ); -printf( "FLA_Tevd_v_opz_var1: ijTL = %d\n", ijTL ); -printf( "FLA_Tevd_v_opz_var1: ijBR = %d\n", ijBR ); -printf( "FLA_Tevd_v_opz_var1: m_A11 = %d\n", m_A11 ); + printf("FLA_Tevd_v_opz_var1: ij_begin = %d\n", ij_begin); + printf("FLA_Tevd_v_opz_var1: ijTL = %d\n", ijTL); + printf("FLA_Tevd_v_opz_var1: ijBR = %d\n", ijBR); + printf("FLA_Tevd_v_opz_var1: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next submatrix @@ -502,7 +511,7 @@ printf( "FLA_Tevd_v_opz_var1: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; + G = buff_G + ijTL * rs_G; // Search for a batch of eigenvalues, recursing on deflated // subproblems whenever a split occurs. Iteration continues @@ -512,25 +521,33 @@ printf( "FLA_Tevd_v_opz_var1: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Tevd_iteracc_v_opd_var1( m_A11, - n_G, - ijTL, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); // Record the number of deflations that were observed. total_deflations += n_deflations; - +#else + FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: deflations observed = %d\n", n_deflations ); -printf( "FLA_Tevd_v_opz_var1: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Tevd_v_opz_var1: num iterations performed = %d\n", n_iter_perf ); + printf("FLA_Tevd_v_opz_var1: deflations observed = %d\n", n_deflations); + printf("FLA_Tevd_v_opz_var1: total deflations observed = %d\n", total_deflations); + printf("FLA_Tevd_v_opz_var1: num iterations performed = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -541,13 +558,13 @@ printf( "FLA_Tevd_v_opz_var1: num iterations performed = %d\n", n_iter_perf ); m_G_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= m_A * n_iter_max ) + if (n_iter_prev >= m_A * n_iter_max) { #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opz_var1: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; + // return FLA_FAILURE; } } @@ -559,7 +576,7 @@ printf( "FLA_Tevd_v_opz_var1: reached maximum total number of iterations: %d\n", n_U_apply = m_G_sweep_max + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); + printf("FLA_Tevd_v_opz_var1: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); #endif // Apply the Givens rotations. Note that we optimize the scope @@ -575,24 +592,23 @@ printf( "FLA_Tevd_v_opz_var1: applying %d sets of Givens rotations\n", n_iter_pe // Similar to above, we could simply always perform the // application on all m_A columns of A, but instead we apply // only to the first n_U_apply columns to save time. - //FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, - FLA_Apply_G_rf_blz_var3( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, - m_U, - n_U_apply, - buff_G, rs_G, cs_G, - buff_U, rs_U, cs_U, - b_alg ); + // FLA_Apply_G_rf_blz_var5( n_iter_perf_sweep_max, + FLA_Apply_G_rf_blz_var3(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var9( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_blz_var6( n_iter_perf_sweep_max, + m_U, + n_U_apply, + buff_G, rs_G, cs_G, + buff_U, rs_U, cs_U, + b_alg); // Increment the total number of iterations previously performed. n_iter_prev += n_iter_perf_sweep_max; #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var1: total number of iterations performed: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opz_var1: total number of iterations performed: %d\n", n_iter_prev); #endif } return n_iter_prev; } - diff --git a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var2.c b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var2.c index f9a6354a4..46771b804 100644 --- a/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var2.c +++ b/src/lapack/dec/tevd/v/flamec/FLA_Tevd_v_opt_var2.c @@ -1,204 +1,202 @@ /* - Copyright (C) 2014, The University of Texas at Austin + Copyright (C) 2014, The University of Texas at Austin - This file is part of libflame and is available under the 3-Clause - BSD license, which can be found in the LICENSE file at the top-level - directory, or at http://opensource.org/licenses/BSD-3-Clause + This file is part of libflame and is available under the 3-Clause + BSD license, which can be found in the LICENSE file at the top-level + directory, or at http://opensource.org/licenses/BSD-3-Clause */ #include "FLAME.h" -FLA_Error FLA_Tevd_v_opt_var2( dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj R, FLA_Obj W, FLA_Obj U, dim_t b_alg ) +FLA_Error FLA_Tevd_v_opt_var2(dim_t n_iter_max, FLA_Obj d, FLA_Obj e, FLA_Obj G, FLA_Obj R, FLA_Obj W, FLA_Obj U, dim_t b_alg) { - FLA_Error r_val = FLA_SUCCESS; + FLA_Error r_val = FLA_SUCCESS; FLA_Datatype datatype; - integer m_A, m_U, n_G; - integer inc_d; - integer inc_e; - integer rs_G, cs_G; - integer rs_R, cs_R; - integer rs_U, cs_U; - integer rs_W, cs_W; + integer m_A, m_U, n_G; + integer inc_d; + integer inc_e; + integer rs_G, cs_G; + integer rs_R, cs_R; + integer rs_U, cs_U; + integer rs_W, cs_W; - datatype = FLA_Obj_datatype( U ); + datatype = FLA_Obj_datatype(U); - m_A = FLA_Obj_vector_dim( d ); - m_U = FLA_Obj_length( U ); - n_G = FLA_Obj_width( G ); + m_A = FLA_Obj_vector_dim(d); + m_U = FLA_Obj_length(U); + n_G = FLA_Obj_width(G); - inc_d = FLA_Obj_vector_inc( d ); - inc_e = FLA_Obj_vector_inc( e ); - - rs_G = FLA_Obj_row_stride( G ); - cs_G = FLA_Obj_col_stride( G ); + inc_d = FLA_Obj_vector_inc(d); + inc_e = FLA_Obj_vector_inc(e); - rs_R = FLA_Obj_row_stride( R ); - cs_R = FLA_Obj_col_stride( R ); + rs_G = FLA_Obj_row_stride(G); + cs_G = FLA_Obj_col_stride(G); - rs_W = FLA_Obj_row_stride( W ); - cs_W = FLA_Obj_col_stride( W ); + rs_R = FLA_Obj_row_stride(R); + cs_R = FLA_Obj_col_stride(R); - rs_U = FLA_Obj_row_stride( U ); - cs_U = FLA_Obj_col_stride( U ); + rs_W = FLA_Obj_row_stride(W); + cs_W = FLA_Obj_col_stride(W); + rs_U = FLA_Obj_row_stride(U); + cs_U = FLA_Obj_col_stride(U); - switch ( datatype ) + switch (datatype) { - case FLA_FLOAT: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - float* buff_R = FLA_FLOAT_PTR( R ); - float* buff_W = FLA_FLOAT_PTR( W ); - float* buff_U = FLA_FLOAT_PTR( U ); - - r_val = FLA_Tevd_v_ops_var2( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_FLOAT: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + float *buff_R = FLA_FLOAT_PTR(R); + float *buff_W = FLA_FLOAT_PTR(W); + float *buff_U = FLA_FLOAT_PTR(U); + + r_val = FLA_Tevd_v_ops_var2(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_DOUBLE: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - double* buff_R = FLA_DOUBLE_PTR( R ); - double* buff_W = FLA_DOUBLE_PTR( W ); - double* buff_U = FLA_DOUBLE_PTR( U ); - - r_val = FLA_Tevd_v_opd_var2( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_DOUBLE: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + double *buff_R = FLA_DOUBLE_PTR(R); + double *buff_W = FLA_DOUBLE_PTR(W); + double *buff_U = FLA_DOUBLE_PTR(U); + + r_val = FLA_Tevd_v_opd_var2(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_COMPLEX: - { - float* buff_d = FLA_FLOAT_PTR( d ); - float* buff_e = FLA_FLOAT_PTR( e ); - scomplex* buff_G = FLA_COMPLEX_PTR( G ); - float* buff_R = FLA_FLOAT_PTR( R ); - scomplex* buff_W = FLA_COMPLEX_PTR( W ); - scomplex* buff_U = FLA_COMPLEX_PTR( U ); - - r_val = FLA_Tevd_v_opc_var2( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_COMPLEX: + { + float *buff_d = FLA_FLOAT_PTR(d); + float *buff_e = FLA_FLOAT_PTR(e); + scomplex *buff_G = FLA_COMPLEX_PTR(G); + float *buff_R = FLA_FLOAT_PTR(R); + scomplex *buff_W = FLA_COMPLEX_PTR(W); + scomplex *buff_U = FLA_COMPLEX_PTR(U); + + r_val = FLA_Tevd_v_opc_var2(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + b_alg); + + break; + } - case FLA_DOUBLE_COMPLEX: - { - double* buff_d = FLA_DOUBLE_PTR( d ); - double* buff_e = FLA_DOUBLE_PTR( e ); - dcomplex* buff_G = FLA_DOUBLE_COMPLEX_PTR( G ); - double* buff_R = FLA_DOUBLE_PTR( R ); - dcomplex* buff_W = FLA_DOUBLE_COMPLEX_PTR( W ); - dcomplex* buff_U = FLA_DOUBLE_COMPLEX_PTR( U ); - - r_val = FLA_Tevd_v_opz_var2( m_A, - m_U, - n_G, - n_iter_max, - buff_d, inc_d, - buff_e, inc_e, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - buff_W, rs_W, cs_W, - buff_U, rs_U, cs_U, - b_alg ); - - break; - } + case FLA_DOUBLE_COMPLEX: + { + double *buff_d = FLA_DOUBLE_PTR(d); + double *buff_e = FLA_DOUBLE_PTR(e); + dcomplex *buff_G = FLA_DOUBLE_COMPLEX_PTR(G); + double *buff_R = FLA_DOUBLE_PTR(R); + dcomplex *buff_W = FLA_DOUBLE_COMPLEX_PTR(W); + dcomplex *buff_U = FLA_DOUBLE_COMPLEX_PTR(U); + + r_val = FLA_Tevd_v_opz_var2(m_A, + m_U, + n_G, + n_iter_max, + buff_d, inc_d, + buff_e, inc_e, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + buff_W, rs_W, cs_W, + buff_U, rs_U, cs_U, + b_alg); + + break; + } } return r_val; } - - -FLA_Error FLA_Tevd_v_ops_var2( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - float* buff_R, integer rs_R, integer cs_R, - float* buff_W, integer rs_W, integer cs_W, - float* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_ops_var2(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + float *buff_R, integer rs_R, integer cs_R, + float *buff_W, integer rs_W, integer cs_W, + float *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } - - -FLA_Error FLA_Tevd_v_opd_var2( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - double* buff_R, integer rs_R, integer cs_R, - double* buff_W, integer rs_W, integer cs_W, - double* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_opd_var2(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + double *buff_R, integer rs_R, integer cs_R, + double *buff_W, integer rs_W, integer cs_W, + double *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - dcomplex one = bl1_z1(); - double rone = bl1_d1(); - double rzero = bl1_d0(); - - dcomplex* G; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_G_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_U_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rone = bl1_d1(); + double rzero = bl1_d0(); + + dcomplex *G; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_G_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_U_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0; +#endif // Initialize our completion flag. done = FALSE; @@ -210,18 +208,18 @@ FLA_Error FLA_Tevd_v_opd_var2( integer m_A, n_iter_prev = 0; // Initialize R to identity. - bl1_dident( m_A, - buff_R, rs_R, cs_R ); + bl1_dident(m_A, + buff_R, rs_R, cs_R); // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G to contain only identity rotations. - bl1_zsetm( m_G_sweep_max, - n_G, - &one, - buff_G, rs_G, cs_G ); + bl1_zsetm(m_G_sweep_max, + n_G, + &one, + buff_G, rs_G, cs_G); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -231,12 +229,12 @@ FLA_Error FLA_Tevd_v_opd_var2( integer m_A, // Perform a sweep: Move through the matrix and perform a tridiagonal // EVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be m_A - 1. - for ( ij_begin = 0; ij_begin < m_A; ) + for (ij_begin = 0; ij_begin < m_A;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Tevd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Tevd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -246,12 +244,12 @@ printf( "FLA_Tevd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // subdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Tevd_find_submatrix_opd( m_A, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Tevd_find_submatrix_opd(m_A, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -259,13 +257,13 @@ printf( "FLA_Tevd_v_opd_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var2: subdiagonal is completely zero.\n" ); -printf( "FLA_Tevd_v_opd_var2: Francis iteration is done!\n" ); + printf("FLA_Tevd_v_opd_var2: subdiagonal is completely zero.\n"); + printf("FLA_Tevd_v_opd_var2: Francis iteration is done!\n"); #endif done = TRUE; } @@ -287,10 +285,10 @@ printf( "FLA_Tevd_v_opd_var2: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var2: ij_begin = %d\n", ij_begin ); -printf( "FLA_Tevd_v_opd_var2: ijTL = %d\n", ijTL ); -printf( "FLA_Tevd_v_opd_var2: ijBR = %d\n", ijBR ); -printf( "FLA_Tevd_v_opd_var2: m_A11 = %d\n", m_A11 ); + printf("FLA_Tevd_v_opd_var2: ij_begin = %d\n", ij_begin); + printf("FLA_Tevd_v_opd_var2: ijTL = %d\n", ijTL); + printf("FLA_Tevd_v_opd_var2: ijBR = %d\n", ijBR); + printf("FLA_Tevd_v_opd_var2: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next subproblem, if @@ -300,7 +298,7 @@ printf( "FLA_Tevd_v_opd_var2: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; + G = buff_G + ijTL * rs_G; // Search for a batch of eigenvalues, recursing on deflated // subproblems whenever a split occurs. Iteration continues @@ -310,25 +308,34 @@ printf( "FLA_Tevd_v_opd_var2: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Tevd_iteracc_v_opd_var1( m_A11, - n_G, - ijTL, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - &n_iter_perf ); +#ifdef PRINTF + n_deflations = FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); // Record the number of deflations that we observed. total_deflations += n_deflations; - +#else + FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var2: deflations observed = %d\n", n_deflations ); -printf( "FLA_Tevd_v_opd_var2: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Tevd_v_opd_var2: num iterations = %d\n", n_iter_perf ); + printf("FLA_Tevd_v_opd_var2: deflations observed = %d\n", n_deflations); + printf("FLA_Tevd_v_opd_var2: total deflations observed = %d\n", total_deflations); + printf("FLA_Tevd_v_opd_var2: num iterations = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -339,40 +346,38 @@ printf( "FLA_Tevd_v_opd_var2: num iterations = %d\n", n_iter_perf ); m_G_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= m_A * n_iter_max ) + if (n_iter_prev >= m_A * n_iter_max) { #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var2: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opd_var2: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; } } // The sweep is complete. Now we must apply the Givens rotations // that were accumulated during the sweep. - // Recall that the number of columns of U to which we apply // rotations is one more than the number of rotations. n_U_apply = m_G_sweep_max + 1; // Apply the Givens rotations that were computed as part of // the previous batch of iterations. - //FLA_Apply_G_rf_bld_var8b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - m_U, - n_U_apply, - n_iter_prev, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - b_alg ); + // FLA_Apply_G_rf_bld_var8b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + m_U, + n_U_apply, + n_iter_prev, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + b_alg); #ifdef PRINTF -printf( "FLA_Tevd_v_opd_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); + printf("FLA_Tevd_v_opd_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); #endif // Increment the total number of iterations previously performed. @@ -380,79 +385,81 @@ printf( "FLA_Tevd_v_opd_var2: applying %d sets of Givens rotations\n", n_iter_pe } // Copy the contents of Q to temporary storage. - bl1_dcopymt( BLIS1_NO_TRANSPOSE, - m_A, - m_A, - buff_U, rs_U, cs_U, - buff_W, rs_W, cs_W ); - + bl1_dcopymt(BLIS1_NO_TRANSPOSE, + m_A, + m_A, + buff_U, rs_U, cs_U, + buff_W, rs_W, cs_W); // Multiply Q by R, overwriting U. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - m_A, - m_A, - m_A, - &rone, - ( double* )buff_W, rs_W, cs_W, - buff_R, rs_R, cs_R, - &rzero, - ( double* )buff_U, rs_U, cs_U ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + m_A, + m_A, + m_A, + &rone, + (double *)buff_W, rs_W, cs_W, + buff_R, rs_R, cs_R, + &rzero, + (double *)buff_U, rs_U, cs_U); return n_iter_prev; } -FLA_Error FLA_Tevd_v_opc_var2( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - float* buff_d, integer inc_d, - float* buff_e, integer inc_e, - scomplex* buff_G, integer rs_G, integer cs_G, - float* buff_R, integer rs_R, integer cs_R, - scomplex* buff_W, integer rs_W, integer cs_W, - scomplex* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +FLA_Error FLA_Tevd_v_opc_var2(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + float *buff_d, integer inc_d, + float *buff_e, integer inc_e, + scomplex *buff_G, integer rs_G, integer cs_G, + float *buff_R, integer rs_R, integer cs_R, + scomplex *buff_W, integer rs_W, integer cs_W, + scomplex *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED ); + FLA_Check_error_code(FLA_NOT_YET_IMPLEMENTED); return FLA_SUCCESS; } -//#define PRINTF - -FLA_Error FLA_Tevd_v_opz_var2( integer m_A, - integer m_U, - integer n_G, - integer n_iter_max, - double* buff_d, integer inc_d, - double* buff_e, integer inc_e, - dcomplex* buff_G, integer rs_G, integer cs_G, - double* buff_R, integer rs_R, integer cs_R, - dcomplex* buff_W, integer rs_W, integer cs_W, - dcomplex* buff_U, integer rs_U, integer cs_U, - integer b_alg ) +// #define PRINTF + +FLA_Error FLA_Tevd_v_opz_var2(integer m_A, + integer m_U, + integer n_G, + integer n_iter_max, + double *buff_d, integer inc_d, + double *buff_e, integer inc_e, + dcomplex *buff_G, integer rs_G, integer cs_G, + double *buff_R, integer rs_R, integer cs_R, + dcomplex *buff_W, integer rs_W, integer cs_W, + dcomplex *buff_U, integer rs_U, integer cs_U, + integer b_alg) { - dcomplex one = bl1_z1(); - double rone = bl1_d1(); - double rzero = bl1_d0(); - - dcomplex* G; - double* d1; - double* e1; - integer r_val; - integer done; - integer m_G_sweep_max; - integer ij_begin; - integer ijTL, ijBR; - integer m_A11; - integer n_iter_perf; - integer n_U_apply; - integer total_deflations; - integer n_deflations; - integer n_iter_prev; - integer n_iter_perf_sweep_max; + dcomplex one = bl1_z1(); + double rone = bl1_d1(); + double rzero = bl1_d0(); + + dcomplex *G; + double *d1; + double *e1; + integer r_val; + integer done; + integer m_G_sweep_max; + integer ij_begin; + integer ijTL, ijBR; + integer m_A11; + integer n_iter_perf; + integer n_U_apply; + integer n_iter_prev; + integer n_iter_perf_sweep_max; +#ifdef PRINTF + integer n_deflations; + integer total_deflations; + total_deflations = 0; +#endif // Initialize our completion flag. done = FALSE; @@ -464,18 +471,18 @@ FLA_Error FLA_Tevd_v_opz_var2( integer m_A, n_iter_prev = 0; // Initialize R to identity. - bl1_dident( m_A, - buff_R, rs_R, cs_R ); + bl1_dident(m_A, + buff_R, rs_R, cs_R); // Iterate until the matrix has completely deflated. - for ( total_deflations = 0; done != TRUE; ) + for (; done != TRUE;) { // Initialize G to contain only identity rotations. - bl1_zsetm( m_G_sweep_max, - n_G, - &one, - buff_G, rs_G, cs_G ); + bl1_zsetm(m_G_sweep_max, + n_G, + &one, + buff_G, rs_G, cs_G); // Keep track of the maximum number of iterations performed in the // current sweep. This is used when applying the sweep's Givens @@ -485,12 +492,12 @@ FLA_Error FLA_Tevd_v_opz_var2( integer m_A, // Perform a sweep: Move through the matrix and perform a tridiagonal // EVD on each non-zero submatrix that is encountered. During the // first time through, ijTL will be 0 and ijBR will be m_A - 1. - for ( ij_begin = 0; ij_begin < m_A; ) + for (ij_begin = 0; ij_begin < m_A;) { #ifdef PRINTF -if ( ij_begin == 0 ) -printf( "FLA_Tevd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ); + if (ij_begin == 0) + printf("FLA_Tevd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin); #endif // Search for the first submatrix along the diagonal that is @@ -500,12 +507,12 @@ printf( "FLA_Tevd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // subdiagonal elements for proximity to zero. If a given // element is close enough to zero, then it is deemed // converged and manually set to zero. - r_val = FLA_Tevd_find_submatrix_opd( m_A, - ij_begin, - buff_d, inc_d, - buff_e, inc_e, - &ijTL, - &ijBR ); + r_val = FLA_Tevd_find_submatrix_opd(m_A, + ij_begin, + buff_d, inc_d, + buff_e, inc_e, + &ijTL, + &ijBR); // Verify that a submatrix was found. If one was not found, // then we are done with the current sweep. Furthermore, if @@ -513,13 +520,13 @@ printf( "FLA_Tevd_v_opz_var2: beginning new sweep (ij_begin = %d)\n", ij_begin ) // beginning of the matrix (ie: ij_begin == 0), then the // matrix has completely deflated and so we are done with // Francis step iteration. - if ( r_val == FLA_FAILURE ) + if (r_val == FLA_FAILURE) { - if ( ij_begin == 0 ) + if (ij_begin == 0) { #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var2: subdiagonal is completely zero.\n" ); -printf( "FLA_Tevd_v_opz_var2: Francis iteration is done!\n" ); + printf("FLA_Tevd_v_opz_var2: subdiagonal is completely zero.\n"); + printf("FLA_Tevd_v_opz_var2: Francis iteration is done!\n"); #endif done = TRUE; } @@ -541,10 +548,10 @@ printf( "FLA_Tevd_v_opz_var2: Francis iteration is done!\n" ); m_A11 = ijBR - ijTL + 1; #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var2: ij_begin = %d\n", ij_begin ); -printf( "FLA_Tevd_v_opz_var2: ijTL = %d\n", ijTL ); -printf( "FLA_Tevd_v_opz_var2: ijBR = %d\n", ijBR ); -printf( "FLA_Tevd_v_opz_var2: m_A11 = %d\n", m_A11 ); + printf("FLA_Tevd_v_opz_var2: ij_begin = %d\n", ij_begin); + printf("FLA_Tevd_v_opz_var2: ijTL = %d\n", ijTL); + printf("FLA_Tevd_v_opz_var2: ijBR = %d\n", ijBR); + printf("FLA_Tevd_v_opz_var2: m_A11 = %d\n", m_A11); #endif // Adjust ij_begin, which gets us ready for the next subproblem, if @@ -554,7 +561,7 @@ printf( "FLA_Tevd_v_opz_var2: m_A11 = %d\n", m_A11 ); // Index to the submatrices upon which we will operate. d1 = buff_d + ijTL * inc_d; e1 = buff_e + ijTL * inc_e; - G = buff_G + ijTL * rs_G; + G = buff_G + ijTL * rs_G; // Search for a batch of eigenvalues, recursing on deflated // subproblems whenever a split occurs. Iteration continues @@ -564,25 +571,33 @@ printf( "FLA_Tevd_v_opz_var2: m_A11 = %d\n", m_A11 ); // less than n_G. // If/when either of the two above conditions fails to hold, // the function returns. - n_deflations = FLA_Tevd_iteracc_v_opd_var1( m_A11, - n_G, - ijTL, - d1, inc_d, - e1, inc_e, - G, rs_G, cs_G, - &n_iter_perf ); - +#ifdef PRINTF + n_deflations = FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); // Record the number of deflations that we observed. total_deflations += n_deflations; - +#else + FLA_Tevd_iteracc_v_opd_var1(m_A11, + n_G, + ijTL, + d1, inc_d, + e1, inc_e, + G, rs_G, cs_G, + &n_iter_perf); +#endif // Update the maximum number of iterations performed in the // current sweep. - n_iter_perf_sweep_max = fla_max( n_iter_perf_sweep_max, n_iter_perf ); + n_iter_perf_sweep_max = fla_max(n_iter_perf_sweep_max, n_iter_perf); #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var2: deflations observed = %d\n", n_deflations ); -printf( "FLA_Tevd_v_opz_var2: total deflations observed = %d\n", total_deflations ); -printf( "FLA_Tevd_v_opz_var2: num iterations = %d\n", n_iter_perf ); + printf("FLA_Tevd_v_opz_var2: deflations observed = %d\n", n_deflations); + printf("FLA_Tevd_v_opz_var2: total deflations observed = %d\n", total_deflations); + printf("FLA_Tevd_v_opz_var2: num iterations = %d\n", n_iter_perf); #endif // Store the most recent value of ijBR in m_G_sweep_max. @@ -593,40 +608,38 @@ printf( "FLA_Tevd_v_opz_var2: num iterations = %d\n", n_iter_perf ); m_G_sweep_max = ijBR; // Make sure we haven't exceeded our maximum iteration count. - if ( n_iter_prev >= m_A * n_iter_max ) + if (n_iter_prev >= m_A * n_iter_max) { #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var2: reached maximum total number of iterations: %d\n", n_iter_prev ); + printf("FLA_Tevd_v_opz_var2: reached maximum total number of iterations: %d\n", n_iter_prev); #endif FLA_Abort(); - //return FLA_FAILURE; } } // The sweep is complete. Now we must apply the Givens rotations // that were accumulated during the sweep. - // Recall that the number of columns of U to which we apply // rotations is one more than the number of rotations. n_U_apply = m_G_sweep_max + 1; // Apply the Givens rotations that were computed as part of // the previous batch of iterations. - //FLA_Apply_G_rf_bld_var8b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, - FLA_Apply_G_rf_bld_var3b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, - //FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, - m_U, - n_U_apply, - n_iter_prev, - buff_G, rs_G, cs_G, - buff_R, rs_R, cs_R, - b_alg ); + // FLA_Apply_G_rf_bld_var8b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var5b( n_iter_perf_sweep_max, + FLA_Apply_G_rf_bld_var3b(n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var9b( n_iter_perf_sweep_max, + // FLA_Apply_G_rf_bld_var6b( n_iter_perf_sweep_max, + m_U, + n_U_apply, + n_iter_prev, + buff_G, rs_G, cs_G, + buff_R, rs_R, cs_R, + b_alg); #ifdef PRINTF -printf( "FLA_Tevd_v_opz_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max ); + printf("FLA_Tevd_v_opz_var2: applying %d sets of Givens rotations\n", n_iter_perf_sweep_max); #endif // Increment the total number of iterations previously performed. @@ -634,25 +647,23 @@ printf( "FLA_Tevd_v_opz_var2: applying %d sets of Givens rotations\n", n_iter_pe } // Copy the contents of Q to temporary storage. - bl1_zcopymt( BLIS1_NO_TRANSPOSE, - m_A, - m_A, - buff_U, rs_U, cs_U, - buff_W, rs_W, cs_W ); - + bl1_zcopymt(BLIS1_NO_TRANSPOSE, + m_A, + m_A, + buff_U, rs_U, cs_U, + buff_W, rs_W, cs_W); // Multiply Q by R, overwriting U. - bl1_dgemm( BLIS1_NO_TRANSPOSE, - BLIS1_NO_TRANSPOSE, - 2*m_A, - m_A, - m_A, - &rone, - ( double* )buff_W, rs_W, 2*cs_W, - buff_R, rs_R, cs_R, - &rzero, - ( double* )buff_U, rs_U, 2*cs_U ); + bl1_dgemm(BLIS1_NO_TRANSPOSE, + BLIS1_NO_TRANSPOSE, + 2 * m_A, + m_A, + m_A, + &rone, + (double *)buff_W, rs_W, 2 * cs_W, + buff_R, rs_R, cs_R, + &rzero, + (double *)buff_U, rs_U, 2 * cs_U); return n_iter_prev; } - diff --git a/src/lapack/misc/ttmm/front/flamec/FLA_Ttmm.c b/src/lapack/misc/ttmm/front/flamec/FLA_Ttmm.c index ec7a5c2f2..2a9a51199 100644 --- a/src/lapack/misc/ttmm/front/flamec/FLA_Ttmm.c +++ b/src/lapack/misc/ttmm/front/flamec/FLA_Ttmm.c @@ -43,6 +43,40 @@ FLA_Error FLA_Ttmm( FLA_Uplo uplo, FLA_Obj A ) r_val = FLA_Ttmm_internal( uplo, A, fla_ttmm_cntl ); } + switch( datatype ){ + + case FLA_COMPLEX: + { + scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); + integer ldim_A = FLA_Obj_col_stride( A ); + + /* Force diagonal elements 1..N-1 to be real to match + netlib LAPACK clauu2.f */ + for (integer i=0; i 0 ) @@ -430,8 +338,6 @@ FLA_Error FLA_Fused_UZhu_ZUhu_opc_var1( integer m_U, scomplex alpha; scomplex beta; - /*------------------------------------------------------------*/ - bl1_cdot( BLIS1_CONJUGATE, m_U, z1, rs_Z, @@ -454,26 +360,12 @@ FLA_Error FLA_Fused_UZhu_ZUhu_opc_var1( integer m_U, &alpha, u1, rs_U, w, inc_w ); -/* - F77_caxpy( &m_U, - &alpha, - u1, &rs_U, - w, &inc_w ); -*/ bl1_caxpyv( BLIS1_NO_CONJUGATE, m_U, &beta, z1, rs_U, w, inc_w ); -/* - F77_caxpy( &m_U, - &beta, - z1, &rs_Z, - w, &inc_w ); -*/ - - /*------------------------------------------------------------*/ } @@ -491,8 +383,6 @@ FLA_Error FLA_Fused_UZhu_ZUhu_opz_var1( integer m_U, dcomplex* buff_u, integer inc_u, dcomplex* buff_w, integer inc_w ) { - //dcomplex zero = bl1_z0(); - integer n_run = n_U / 1; integer n_left = n_U % 1; integer step_u = 1*cs_U; @@ -502,95 +392,24 @@ FLA_Error FLA_Fused_UZhu_ZUhu_opz_var1( integer m_U, dcomplex* u = buff_u; dcomplex* w = buff_w; - //dcomplex* delta = buff_delta; - dcomplex* u1; - dcomplex* u2; dcomplex* z1; - dcomplex* z2; dcomplex* tau1; - dcomplex* tau2; u1 = buff_U; - u2 = buff_U + cs_U; z1 = buff_Z; - z2 = buff_Z + cs_Z; tau1 = buff_t; - tau2 = buff_t + inc_t; for ( i = 0; i < n_run; ++i ) { dcomplex rho_z1u; - //dcomplex rho_z2u; dcomplex rho_u1u; - //dcomplex rho_u2u; - - /*------------------------------------------------------------*/ /* Effective computation: w = w + delta * ( U ( Z' u ) + Z ( U' u ) ); */ -/* - bl1_zdotsv2( BLIS1_CONJUGATE, - m_U, - z1, rs_Z, - u1, rs_U, - u, inc_u, - &zero, - &rho_z1u, - &rho_u1u ); - - *tau1 = rho_u1u; - - //bl1_zscals( delta, &rho_z1u ); - //bl1_zscals( delta, &rho_u1u ); - bl1_zneg1( &rho_z1u ); - bl1_zneg1( &rho_u1u ); - - bl1_zaxpyv2b( m_U, - &rho_z1u, - &rho_u1u, - u1, rs_U, - z1, rs_Z, - w, inc_w ); -*/ -/* - bl1_zdotsv2( BLIS1_CONJUGATE, - m_U, - z1, rs_Z, - z2, rs_Z, - u, inc_u, - &zero, - &rho_z1u, - &rho_z2u ); - bl1_zneg1( &rho_z1u ); - bl1_zneg1( &rho_z2u ); - - bl1_zdotv2axpyv2b( m_U, - u1, rs_U, - u2, rs_U, - u, inc_u, - &rho_z1u, - &rho_z2u, - &rho_u1u, - &rho_u2u, - w, inc_w ); - - *tau1 = rho_u1u; - *tau2 = rho_u2u; - - bl1_zneg1( &rho_u1u ); - bl1_zneg1( &rho_u2u ); - - bl1_zaxpyv2b( m_U, - &rho_u1u, - &rho_u2u, - z1, rs_Z, - z2, rs_Z, - w, inc_w ); -*/ bl1_zdot( BLIS1_CONJUGATE, m_U, z1, rs_Z, @@ -615,14 +434,9 @@ FLA_Error FLA_Fused_UZhu_ZUhu_opz_var1( integer m_U, z1, rs_Z, w, inc_w ); - /*------------------------------------------------------------*/ - u1 += step_u; - u2 += step_u; z1 += step_z; - z2 += step_z; tau1 += step_tau; - tau2 += step_tau; } if ( n_left == 1 ) diff --git a/src/lapack/x86/CMakeLists.txt b/src/lapack/x86/CMakeLists.txt index 6345b6711..69547735d 100644 --- a/src/lapack/x86/CMakeLists.txt +++ b/src/lapack/x86/CMakeLists.txt @@ -1,3 +1,6 @@ -##Copyright (C) 2022, Advanced Micro Devices, Inc.## +##Copyright (C) 2023, Advanced Micro Devices, Inc.## add_subdirectory(front) +remove_definitions(/arch:AVX) add_subdirectory(avx2) +remove_definitions(/arch:AVX2) +add_subdirectory(avx512) diff --git a/src/lapack/x86/avx2/CMakeLists.txt b/src/lapack/x86/avx2/CMakeLists.txt index 4aba44b1b..a9239a010 100644 --- a/src/lapack/x86/avx2/CMakeLists.txt +++ b/src/lapack/x86/avx2/CMakeLists.txt @@ -1,9 +1,10 @@ -##Copyright (C) 2022, Advanced Micro Devices, Inc.## -target_sources("${PROJECT_NAME}" - PRIVATE +##Copyright (C) 2023, Advanced Micro Devices, Inc.## +add_library(AVX2_LU + OBJECT ${CMAKE_CURRENT_SOURCE_DIR}/fla_lapack_avx2_kernels.h +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgeqrf_small_avx2.h ${CMAKE_CURRENT_SOURCE_DIR}/fla_dgeqrf_small_avx2.c -${CMAKE_CURRENT_SOURCE_DIR}/fla_dgetrf_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgetrf_small_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_dhrot3_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_drot_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_dscal_ix1_avx2.c @@ -12,4 +13,16 @@ ${CMAKE_CURRENT_SOURCE_DIR}/fla_sscal_ix1_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_zgetrf_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_zrot_avx2.c ${CMAKE_CURRENT_SOURCE_DIR}/fla_zscal_ix1_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_lu_piv_small_d_update_tr_matrix_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgesvd_nn_small10_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgesvd_small6_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgesvd_small6T_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgesvd_nn_small1T_avx2.c +${CMAKE_CURRENT_SOURCE_DIR}/fla_dgetrs_small_trsm_ll_avx2.c ) + +if(WIN32) +target_compile_options(AVX2_LU PRIVATE /arch:AVX2) +else(UNIX) +target_compile_options(AVX2_LU PRIVATE -mavx2 -mfma) +endif() diff --git a/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c b/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c index c3f8636e4..fb8a7f611 100644 --- a/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c +++ b/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.c @@ -7,104 +7,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT - -/* Combining three accumulators of norm to get final norm */ -#define FLA_GEQRF_SMALL_GET_NORM() \ - fnorm = 0.0; \ - if (big_sum > 0.0) \ - { \ - fnorm = big_sum; \ - if (med_sum > 0.0) \ - { \ - fnorm = fnorm + (med_sum * scale_big) * scale_big; \ - } \ - scale = scale_big; \ - } \ - else /* small sum must be non-zero */ \ - { \ - doublereal ymin, ymax; \ - if (med_sum > 0.0) \ - { \ - med_sum = sqrt(med_sum); \ - sml_sum = sqrt(sml_sum) / scale_sml; \ - \ - ymin = fla_min(med_sum, sml_sum); \ - ymax = fla_max(med_sum, sml_sum); \ - \ - scale = 1.0; \ - fnorm = ymax * ymax * (1.0 + (ymin / ymax) * (ymin / ymax)); \ - } \ - else \ - { \ - scale = scale_sml; \ - fnorm = sml_sum; \ - } \ - } \ - xnorm = sqrt(fnorm) / scale; - -/* NORM computation using 256-bit AVX2 intrinsics */ -#define FLA_GEQRF_SMALL_CALC_NORM4(idx) \ - /* load input and get its absolute values */ \ - vd4_inp = _mm256_loadu_pd(&iptr[idx]); \ - vd4_abs_inp = _mm256_andnot_pd(vd4_zero, vd4_inp); \ - \ - /* segregate input values into small, medium and big */ \ - vd4_smsk = _mm256_cmp_pd(vd4_abs_inp, vd4_sth, _CMP_LT_OQ); \ - vd4_bmsk = _mm256_cmp_pd(vd4_abs_inp, vd4_bth, _CMP_GT_OQ); \ - vd4_mmsk = _mm256_or_pd(vd4_smsk, vd4_bmsk); \ - \ - /* if all inputs are in medium range */ \ - if (_mm256_testz_pd(vd4_mmsk, vd4_mmsk)) \ - { \ - vd4_msum = _mm256_fmadd_pd(vd4_inp, vd4_inp, vd4_msum); \ - } \ - else /* for small and large inputs */ \ - { \ - has_outliers = 1; \ - vd4_sinp = _mm256_blendv_pd(vd4_zero, vd4_abs_inp, vd4_smsk); \ - vd4_binp = _mm256_blendv_pd(vd4_zero, vd4_abs_inp, vd4_bmsk); \ - vd4_minp = _mm256_blendv_pd(vd4_abs_inp, vd4_zero, vd4_mmsk); \ - \ - /* scale, square and add as applicable */ \ - vd4_sinp = _mm256_mul_pd(vd4_sinp, vd4_sscl); \ - vd4_binp = _mm256_mul_pd(vd4_binp, vd4_bscl); \ - \ - vd4_msum = _mm256_fmadd_pd(vd4_minp, vd4_minp, vd4_msum); \ - vd4_ssum = _mm256_fmadd_pd(vd4_sinp, vd4_sinp, vd4_ssum); \ - vd4_bsum = _mm256_fmadd_pd(vd4_binp, vd4_binp, vd4_bsum); \ - } - -/* NORM computation using 128-bit AVX intrinsics */ -#define FLA_GEQRF_SMALL_CALC_NORM2() \ - /* get absolute value of the vector input */ \ - vd2_abs_inp = _mm_andnot_pd(vd2_zero, vd2_inp); \ - \ - /* compute flags to detect out-of-range values */ \ - vd2_smsk = _mm_cmp_pd(vd2_abs_inp, vd2_sth, _CMP_LT_OQ); \ - vd2_bmsk = _mm_cmp_pd(vd2_abs_inp, vd2_bth, _CMP_GT_OQ); \ - vd2_mmsk = _mm_or_pd(vd2_smsk, vd2_bmsk); \ - \ - /* if all inputs are in medium range */ \ - if (_mm_testz_pd(vd2_mmsk, vd2_mmsk)) \ - { \ - vd2_msum = _mm_fmadd_pd(vd2_inp, vd2_inp, vd2_msum); \ - } \ - else /* for small and large inputs */ \ - { \ - has_outliers = 1; \ - vd2_sinp = _mm_blendv_pd(vd2_zero, vd2_abs_inp, vd2_smsk); \ - vd2_binp = _mm_blendv_pd(vd2_zero, vd2_abs_inp, vd2_bmsk); \ - vd2_minp = _mm_blendv_pd(vd2_abs_inp, vd2_zero, vd2_mmsk); \ - \ - /* scale, square and add as applicable */ \ - vd2_sinp = _mm_mul_pd(vd2_sinp, vd2_sscl); \ - vd2_binp = _mm_mul_pd(vd2_binp, vd2_bscl); \ - vd2_ssum = _mm_fmadd_pd(vd2_sinp, vd2_sinp, vd2_ssum); \ - vd2_bsum = _mm_fmadd_pd(vd2_binp, vd2_binp, vd2_bsum); \ - vd2_msum = _mm_fmadd_pd(vd2_minp, vd2_minp, vd2_msum); \ - } +#if FLA_ENABLE_AMD_OPT static integer c__1 = 1; /* QR for small sizes */ @@ -112,56 +17,13 @@ int fla_dgeqrf_small_avx2(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *work) { - integer i, j, k; - integer min_m_n, kcnt; - integer slen, a_offset; - integer acols, arows; - doublereal xnorm, vnorm, dtmp; - doublereal fnorm, scale; - doublereal med_sum, sml_sum, big_sum; - doublereal alpha, beta, ntau; - doublereal *v, *A, *ac; - - static int r_once = 1; - static doublereal safmin, rsafmin; - /* Constants chosen to minimize roundoff, according to Blue's algorithm */ - static doublereal thres_sml = 1.491668e-154; - static doublereal thres_big = 1.997919e+146; - static doublereal scale_sml = 4.498914e+161; - static doublereal scale_big = 1.111379e-162; + /* Declare and init local variables */ + FLA_GEQRF_INIT_DSMALL(); - __m128d vd2_inp, vd2_abs_inp; - __m128d vd2_sth, vd2_bth, vd2_sscl, vd2_bscl; - __m128d vd2_sinp, vd2_binp, vd2_minp; - __m128d vd2_smsk, vd2_bmsk, vd2_mmsk; - __m128d vd2_ssum, vd2_bsum, vd2_msum; - __m128d vd2_norm, vd2_vj1, vd2_dtmp; - __m128d vd2_ntau, vd2_ltmp, vd2_htmp; - __m128d vd2_zero = _mm_set1_pd(-0.0f); - - __m256d vd4_inp, vd4_abs_inp; - __m256d vd4_sth, vd4_bth, vd4_sscl, vd4_bscl; - __m256d vd4_sinp, vd4_binp, vd4_minp; - __m256d vd4_smsk, vd4_bmsk, vd4_mmsk; - __m256d vd4_ssum, vd4_bsum, vd4_msum; - __m256d vd4_norm, vd4_vj, vd4_dtmp; - __m256d vd4_zero = _mm256_set1_pd(-0.0f); - - if (r_once) - { - safmin = dlamch_("S") / dlamch_("E"); - rsafmin = 1. / safmin; - r_once = 0; - } - - vd2_sth = _mm_set1_pd(thres_sml); - vd2_bth = _mm_set1_pd(thres_big); - vd2_sscl = _mm_set1_pd(scale_sml); - vd2_bscl = _mm_set1_pd(scale_big); + integer min_m_n; /* Adjust pointers */ - a_offset = 1 + *lda * 1; - a -= a_offset; + a -= (1 + *lda * 1); tau--; work--; @@ -173,391 +35,19 @@ int fla_dgeqrf_small_avx2(integer *m, integer *n, const doublereal *iptr = (const doublereal *) &a[i + 1 + i * *lda - 1]; integer has_outliers = 0; - if (slen < 4) + if (slen <= 0) { - /* calculate norm of sub-diagonal elements in current column */ - med_sum = sml_sum = big_sum = 0.; - vd2_msum = _mm_setzero_pd(); - vd2_ssum = _mm_setzero_pd(); - vd2_bsum = _mm_setzero_pd(); - - /* process two inputs per iteration */ - for (j = 1; j <= (slen - 1); j += 2) - { - vd2_inp = _mm_loadu_pd(&iptr[j]); - FLA_GEQRF_SMALL_CALC_NORM2(); - } - - if (j == slen) - { - /* load input and get its absolute values */ - vd2_inp = _mm_load_sd(&iptr[j]); - FLA_GEQRF_SMALL_CALC_NORM2(); - } - - /* Get all the three sums */ - med_sum = vd2_msum[0] + vd2_msum[1]; - /* Combining outlier accumulators if non-zero */ - if (has_outliers) - { - sml_sum = vd2_ssum[0] + vd2_ssum[1]; - big_sum = vd2_bsum[0] + vd2_bsum[1]; - FLA_GEQRF_SMALL_GET_NORM(); - } - else - { - xnorm = sqrt(med_sum); - } - - /* Compute Householder Reflector parameters */ - if (xnorm == 0.) /* Sub-diagonal elements are already zero */ - { - tau[i] = 0.; - } - else /* Non-zero sub-diagonal elements */ - { - /* Part 1: Compute Householder vector 'v' and tau */ - - v = &a[i + i * *lda - 1]; - A = &a[i + (i + 1) * *lda]; - alpha = v[1]; - - if (alpha != alpha || xnorm != xnorm) /* check for not a number */ - { - beta = alpha + xnorm; - } - else - { - doublereal px0, w, z; - - px0 = f2c_abs(alpha); - w = fla_max(px0, xnorm); - z = fla_min(px0, xnorm); - - z = z / w; - beta = w * sqrt(z * z + 1); - } - beta = (alpha >= 0.) ? -beta : beta; - - /* Scale-up the inputs for small norm */ - for (kcnt = 0; (f2c_abs(beta) < safmin && kcnt <= 20); kcnt++) - { - dscal_(&slen, &rsafmin, &v[2], &c__1); - beta = beta * rsafmin; - alpha = alpha * rsafmin; - } - - /* Calculate tau and v */ - tau[i] = (beta - alpha) / beta; - vnorm = 1. / (alpha - beta); - /* Scale current column by norm to get v */ - vd2_norm = _mm_set1_pd(vnorm); - - /* Normalize using SIMD */ - for (j = 1; j <= (slen - 1); j += 2) - { - vd2_vj1 = _mm_loadu_pd((doublereal const *) &v[j + 1]); - vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); - _mm_storeu_pd((doublereal *) &v[j + 1], vd2_vj1); - } - if (j == slen) - { - vd2_vj1 = _mm_loaddup_pd((doublereal const *) &v[j + 1]); - vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); - _mm_storel_pd((doublereal *) &v[j + 1], vd2_vj1); - } - /* Scale-down beta */ - for ( ; kcnt >= 1; kcnt--) - { - beta = beta * safmin; - } - - /* Part 2: Apply the Householder rotation on the rest of the matrix - * A = A - tau * v * v**T * A - * = A - v * tau * (A**T * v)**T - * */ - - arows = *m - i + 1; - acols = *n - i; - v[1] = 1.; - ntau = -tau[i]; - vd2_ntau = _mm_set1_pd(ntau); - - /* work = A**T * v */ - for (j = 1; j <= acols; j++) /* for every column c_A of A */ - { - ac = &A[(j - 1) * *lda - 1]; - - /* Compute tmp = c_A**T . v */ - dtmp = 0; - for (k = 1; k <= (arows - 1); k += 2) - { - dtmp = dtmp + ac[k] * v[k]; - dtmp = dtmp + ac[k + 1] * v[k + 1]; - } - if (k == arows) - { - dtmp = dtmp + ac[k] * v[k]; - } - vd2_dtmp = _mm_set1_pd(dtmp); - - /* Compute tmp = -tau * tmp */ - vd2_dtmp = _mm_mul_pd(vd2_dtmp, vd2_ntau); - - /* Compute c_A + tmp * v */ - for (k = 1; k <= (arows - 1); k += 2) - { - /* load column elements of c_A and v */ - vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); - - /* mul by dtmp, add and store */ - vd2_inp = _mm_fmadd_pd(vd2_vj1, vd2_dtmp, vd2_inp); - _mm_storeu_pd((doublereal *) &ac[k], vd2_inp); - } - if (k == arows) - { - /* load single remaining element from c_A and v */ - vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); - - /* multiply with tau and store */ - vd2_inp = _mm_fmadd_pd(vd2_vj1, vd2_dtmp, vd2_inp); - _mm_store_sd((doublereal *) &ac[k], vd2_inp); - } - } - v[1] = beta; - } + tau[i] = 0; + } + else if (slen < 4) + { + FLA_ELEM_REFLECTOR_GENERATE_DSMALL(i, m, n, tau); + FLA_ELEM_REFLECTOR_APPLY_DSMALL(i, m, n, a, tau); } else { - /* calculate norm of sub-diagonal elements in current column */ - med_sum = sml_sum = big_sum = 0.; - vd4_sth = _mm256_set1_pd(thres_sml); - vd4_bth = _mm256_set1_pd(thres_big); - vd4_sscl = _mm256_set1_pd(scale_sml); - vd4_bscl = _mm256_set1_pd(scale_big); - - vd4_msum = _mm256_setzero_pd(); - vd4_ssum = _mm256_setzero_pd(); - vd4_bsum = _mm256_setzero_pd(); - - /* process four inputs per iteration */ - for (j = 1; j <= (slen - 3); j += 4) - { - FLA_GEQRF_SMALL_CALC_NORM4(j); - } - - if (j <= slen) - { /* process remaining iterations */ - vd2_msum = _mm_setzero_pd(); - vd2_ssum = _mm_setzero_pd(); - vd2_bsum = _mm_setzero_pd(); - - /* process two inputs per iteration */ - for ( ; j <= slen; j++) - { - vd2_inp = _mm_loaddup_pd(&iptr[j]); - FLA_GEQRF_SMALL_CALC_NORM2(); - } - /* Get all the three sums */ - med_sum = vd4_msum[0] + vd4_msum[1] + vd4_msum[2] + vd4_msum[3] + vd2_msum[0]; - sml_sum = vd4_ssum[0] + vd4_ssum[1] + vd4_ssum[2] + vd4_ssum[3] + vd2_ssum[0]; - big_sum = vd4_bsum[0] + vd4_bsum[1] + vd4_bsum[2] + vd4_bsum[3] + vd2_bsum[0]; - } - else - { - /* Get all the three sums in case of no remaining iterations */ - med_sum = vd4_msum[0] + vd4_msum[1] + vd4_msum[2] + vd4_msum[3]; - sml_sum = vd4_ssum[0] + vd4_ssum[1] + vd4_ssum[2] + vd4_ssum[3]; - big_sum = vd4_bsum[0] + vd4_bsum[1] + vd4_bsum[2] + vd4_bsum[3]; - } - - /* Combining outlier accumulators if non-zero */ - if (has_outliers) - { - FLA_GEQRF_SMALL_GET_NORM(); - } - else - { - xnorm = sqrt(med_sum); - } - - /* Compute Householder Reflector parameters */ - if (xnorm == 0.) /* Sub-diagonal elements are already zero */ - { - tau[i] = 0.; - } - else /* Non-zero sub-diagonal elements */ - { - /* Part 1: Compute Householder vector 'v' and tau */ - - v = &a[i + i * *lda - 1]; - A = &a[i + (i + 1) * *lda]; - alpha = v[1]; - - /* Compute Householder rotated vector */ - if (alpha != alpha || xnorm != xnorm) /* check for not a number */ - { - beta = alpha + xnorm; - } - else - { - doublereal px0, w, z; - - px0 = f2c_abs(alpha); - w = fla_max(px0, xnorm); - z = fla_min(px0, xnorm); - - z = z / w; - beta = w * sqrt(z * z + 1); - } - beta = (alpha >= 0.) ? -beta : beta; - - /* Scale-up the inputs for small norm */ - for (kcnt = 0; (f2c_abs(beta) < safmin && kcnt <= 20); kcnt++) - { - dscal_(&slen, &rsafmin, &v[2], &c__1); - beta = beta * rsafmin; - alpha = alpha * rsafmin; - } - - /* Calculate tau and v */ - tau[i] = (beta - alpha) / beta; - vnorm = 1. / (alpha - beta); - /* Scale current column by norm to get v */ - vd4_norm = _mm256_set1_pd(vnorm); - - /* Normalize using SIMD */ - for (j = 1; j <= (slen - 3); j += 4) - { - vd4_vj = _mm256_loadu_pd((doublereal const *) &v[j + 1]); - vd4_vj = _mm256_mul_pd(vd4_vj, vd4_norm); - _mm256_storeu_pd((doublereal *) &v[j + 1], vd4_vj); - } - /* Remaining iterations through 128-bit SIMD */ - if (j <= slen) - { - vd2_norm = _mm_set1_pd(vnorm); - for ( ; j <= (slen - 1); j += 2) - { - vd2_vj1 = _mm_loadu_pd((doublereal const *) &v[j + 1]); - vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); - _mm_storeu_pd((doublereal *) &v[j + 1], vd2_vj1); - } - if (j == slen) - { - vd2_vj1 = _mm_loaddup_pd((doublereal const *) &v[j + 1]); - vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); - _mm_storel_pd((doublereal *) &v[j + 1], vd2_vj1); - } - } - /* Scale-down beta */ - for ( ; kcnt >= 1; kcnt--) - { - beta = beta * safmin; - } - - /* Part 2: Apply the Householder rotation on the rest of the matrix - * A = A - tau * v * v**T * A - * = A - v * tau * (A**T * v)**T - * */ - - arows = *m - i + 1; - acols = *n - i; - v[1] = 1.; - ntau = -tau[i]; - vd2_ntau = _mm_set1_pd(ntau); - - /* work = A**T * v */ - for (j = 1; j <= acols; j++) /* for every column c_A of A */ - { - ac = &A[(j - 1) * *lda - 1]; - vd2_dtmp = _mm_setzero_pd(); - vd4_dtmp = _mm256_setzero_pd(); - - /* Compute tmp = c_A**T . v */ - for (k = 1; k <= (arows - 3); k += 4) - { - /* load column elements of A and v */ - vd4_inp = _mm256_loadu_pd((const doublereal *) &ac[k]); - vd4_vj = _mm256_loadu_pd((const doublereal *) &v[k]); - - /* take dot product */ - vd4_dtmp = _mm256_fmadd_pd(vd4_inp, vd4_vj, vd4_dtmp); - } - if (k < arows) - { - /* load column elements of A and v */ - vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); - - /* take dot product */ - vd2_dtmp = _mm_fmadd_pd(vd2_inp, vd2_vj1, vd2_dtmp); - k += 2; - } - if (k == arows) - { - /* load single remaining element from c_A and v */ - vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); - - /* take dot product */ - vd2_dtmp = _mm_fmadd_pd(vd2_inp, vd2_vj1, vd2_dtmp); - } - /* Horizontal add of dtmp */ - vd2_ltmp = _mm256_castpd256_pd128(vd4_dtmp); - vd2_htmp = _mm256_extractf128_pd(vd4_dtmp, 0x1); - - vd2_dtmp = _mm_add_pd(vd2_dtmp, vd2_ltmp); - vd2_dtmp = _mm_add_pd(vd2_dtmp, vd2_htmp); - vd2_dtmp = _mm_hadd_pd(vd2_dtmp, vd2_dtmp); - - /* Compute tmp = - tau * tmp */ - vd2_dtmp = _mm_mul_pd(vd2_dtmp, vd2_ntau); - vd4_dtmp = _mm256_castpd128_pd256(vd2_dtmp); - vd4_dtmp = _mm256_insertf128_pd(vd4_dtmp, vd2_dtmp, 0x1); - - /* alternate for above 2 instructions which do not - * compile for older gcc versions (7 and below). - * Both will be same in terms of latency though */ - /* vd4_dtmp = _mm256_set_m128d(vd2_dtmp, vd2_dtmp); */ - - /* Compute c_A + tmp * v */ - for (k = 1; k <= (arows - 3); k += 4) - { - /* load column elements of c_A and v */ - vd4_inp = _mm256_loadu_pd((const doublereal *) &ac[k]); - vd4_vj = _mm256_loadu_pd((const doublereal *) &v[k]); - - /* mul by dtmp, add and store */ - vd4_inp = _mm256_fmadd_pd(vd4_dtmp, vd4_vj, vd4_inp); - _mm256_storeu_pd((doublereal *) &ac[k], vd4_inp); - } - if (k < arows) - { - /* load column elements of c_A and v */ - vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); - - /* mul by dtmp, add and store */ - vd2_inp = _mm_fmadd_pd(vd2_dtmp, vd2_vj1, vd2_inp); - _mm_storeu_pd((doublereal *) &ac[k], vd2_inp); - k += 2; - } - if (k == arows) - { - /* load single remaining element from c_A and v */ - vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); - vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); - - /* mul by dtmp, add and store */ - vd2_inp = _mm_fmadd_pd(vd2_dtmp, vd2_vj1, vd2_inp); - _mm_storel_pd((doublereal *) &ac[k], vd2_inp); - } - } - v[1] = beta; - } + FLA_ELEM_REFLECTOR_GENERATE_DLARGE(i, m, n, tau); + FLA_ELEM_REFLECTOR_APPLY_DLARGE(i, m, n, a, lda, tau); } } return 0; diff --git a/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.h b/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.h new file mode 100644 index 000000000..0ba4ec120 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgeqrf_small_avx2.h @@ -0,0 +1,664 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_dgeqrf_small_avx2.h + * @brief QR Kernels for small sizes. + * */ + +#if FLA_ENABLE_AMD_OPT + +/* Declaration of local variables for QR Small */ +#define FLA_GEQRF_INIT_DSMALL() \ + integer i, j, k; \ + integer kcnt, slen; \ + integer acols, arows; \ + doublereal xnorm, vnorm, dtmp; \ + doublereal fnorm, scale; \ + doublereal med_sum, sml_sum, big_sum; \ + doublereal alpha, beta, ntau; \ + doublereal *v, *A, *ac; \ + \ + static TLS_CLASS_SPEC int r_once = 1; \ + static doublereal safmin, rsafmin; \ + /* Constants chosen to minimize roundoff, */ \ + /* according to Blue's algorithm */ \ + static doublereal thres_sml = 1.491668e-154; \ + static doublereal thres_big = 1.997919e+146; \ + static doublereal scale_sml = 4.498914e+161; \ + static doublereal scale_big = 1.111379e-162; \ + \ + __m128d vd2_inp, vd2_abs_inp; \ + __m128d vd2_sth, vd2_bth, vd2_sscl, vd2_bscl; \ + __m128d vd2_sinp, vd2_binp, vd2_minp; \ + __m128d vd2_smsk, vd2_bmsk, vd2_mmsk; \ + __m128d vd2_ssum, vd2_bsum, vd2_msum; \ + __m128d vd2_norm, vd2_vj1, vd2_dtmp; \ + __m128d vd2_ntau, vd2_ltmp, vd2_htmp; \ + __m128d vd2_zero = _mm_set1_pd(-0.0f); \ + \ + __m256d vd4_inp, vd4_abs_inp; \ + __m256d vd4_sth, vd4_bth, vd4_sscl, vd4_bscl; \ + __m256d vd4_sinp, vd4_binp, vd4_minp; \ + __m256d vd4_smsk, vd4_bmsk, vd4_mmsk; \ + __m256d vd4_ssum, vd4_bsum, vd4_msum; \ + __m256d vd4_norm, vd4_vj, vd4_dtmp; \ + __m256d vd4_zero = _mm256_set1_pd(-0.0f); \ + \ + if (r_once) \ + { \ + safmin = dlamch_("S") / dlamch_("E"); \ + rsafmin = 1. / safmin; \ + r_once = 0; \ + } \ + \ + vd2_sth = _mm_set1_pd(thres_sml); \ + vd2_bth = _mm_set1_pd(thres_big); \ + vd2_sscl = _mm_set1_pd(scale_sml); \ + vd2_bscl = _mm_set1_pd(scale_big); + +/* Combining three accumulators of norm to get final norm */ +#define FLA_GEQRF_SMALL_GET_NORM() \ + fnorm = 0.0; \ + if (big_sum > 0.0) \ + { \ + fnorm = big_sum; \ + if (med_sum > 0.0) \ + { \ + fnorm = fnorm + (med_sum * scale_big) * scale_big; \ + } \ + scale = scale_big; \ + } \ + else /* small sum must be non-zero */ \ + { \ + doublereal ymin, ymax; \ + if (med_sum > 0.0) \ + { \ + med_sum = sqrt(med_sum); \ + sml_sum = sqrt(sml_sum) / scale_sml; \ + \ + ymin = fla_min(med_sum, sml_sum); \ + ymax = fla_max(med_sum, sml_sum); \ + \ + scale = 1.0; \ + fnorm = ymax * ymax * (1.0 + (ymin / ymax) * (ymin / ymax)); \ + } \ + else \ + { \ + scale = scale_sml; \ + fnorm = sml_sum; \ + } \ + } \ + xnorm = sqrt(fnorm) / scale; + +/* NORM computation using 256-bit AVX2 intrinsics */ +#define FLA_GEQRF_SMALL_CALC_NORM4(idx) \ + /* load input and get its absolute values */ \ + vd4_inp = _mm256_loadu_pd(&iptr[idx]); \ + vd4_abs_inp = _mm256_andnot_pd(vd4_zero, vd4_inp); \ + \ + /* segregate input values into small, medium and big */ \ + vd4_smsk = _mm256_cmp_pd(vd4_abs_inp, vd4_sth, _CMP_LT_OQ); \ + vd4_bmsk = _mm256_cmp_pd(vd4_abs_inp, vd4_bth, _CMP_GT_OQ); \ + vd4_mmsk = _mm256_or_pd(vd4_smsk, vd4_bmsk); \ + \ + /* if all inputs are in medium range */ \ + if (_mm256_testz_pd(vd4_mmsk, vd4_mmsk)) \ + { \ + vd4_msum = _mm256_fmadd_pd(vd4_inp, vd4_inp, vd4_msum); \ + } \ + else /* for small and large inputs */ \ + { \ + has_outliers = 1; \ + vd4_sinp = _mm256_blendv_pd(vd4_zero, vd4_abs_inp, vd4_smsk); \ + vd4_binp = _mm256_blendv_pd(vd4_zero, vd4_abs_inp, vd4_bmsk); \ + vd4_minp = _mm256_blendv_pd(vd4_abs_inp, vd4_zero, vd4_mmsk); \ + \ + /* scale, square and add as applicable */ \ + vd4_sinp = _mm256_mul_pd(vd4_sinp, vd4_sscl); \ + vd4_binp = _mm256_mul_pd(vd4_binp, vd4_bscl); \ + \ + vd4_msum = _mm256_fmadd_pd(vd4_minp, vd4_minp, vd4_msum); \ + vd4_ssum = _mm256_fmadd_pd(vd4_sinp, vd4_sinp, vd4_ssum); \ + vd4_bsum = _mm256_fmadd_pd(vd4_binp, vd4_binp, vd4_bsum); \ + } + +/* NORM computation using 128-bit AVX intrinsics */ +#define FLA_GEQRF_SMALL_CALC_NORM2() \ + /* get absolute value of the vector input */ \ + vd2_abs_inp = _mm_andnot_pd(vd2_zero, vd2_inp); \ + \ + /* compute flags to detect out-of-range values */ \ + vd2_smsk = _mm_cmp_pd(vd2_abs_inp, vd2_sth, _CMP_LT_OQ); \ + vd2_bmsk = _mm_cmp_pd(vd2_abs_inp, vd2_bth, _CMP_GT_OQ); \ + vd2_mmsk = _mm_or_pd(vd2_smsk, vd2_bmsk); \ + \ + /* if all inputs are in medium range */ \ + if (_mm_testz_pd(vd2_mmsk, vd2_mmsk)) \ + { \ + vd2_msum = _mm_fmadd_pd(vd2_inp, vd2_inp, vd2_msum); \ + } \ + else /* for small and large inputs */ \ + { \ + has_outliers = 1; \ + vd2_sinp = _mm_blendv_pd(vd2_zero, vd2_abs_inp, vd2_smsk); \ + vd2_binp = _mm_blendv_pd(vd2_zero, vd2_abs_inp, vd2_bmsk); \ + vd2_minp = _mm_blendv_pd(vd2_abs_inp, vd2_zero, vd2_mmsk); \ + \ + /* scale, square and add as applicable */ \ + vd2_sinp = _mm_mul_pd(vd2_sinp, vd2_sscl); \ + vd2_binp = _mm_mul_pd(vd2_binp, vd2_bscl); \ + vd2_ssum = _mm_fmadd_pd(vd2_sinp, vd2_sinp, vd2_ssum); \ + vd2_bsum = _mm_fmadd_pd(vd2_binp, vd2_binp, vd2_bsum); \ + vd2_msum = _mm_fmadd_pd(vd2_minp, vd2_minp, vd2_msum); \ + } + +#define FLA_ELEM_REFLECTOR_GENERATE_DSMALL(i, m, n, tau) \ + /* calculate norm of sub-diagonal elements in current column */ \ + med_sum = sml_sum = big_sum = 0.; \ + vd2_msum = _mm_setzero_pd(); \ + vd2_ssum = _mm_setzero_pd(); \ + vd2_bsum = _mm_setzero_pd(); \ + \ + /* process two inputs per iteration */ \ + for (j = 1; j <= (slen - 1); j += 2) \ + { \ + vd2_inp = _mm_loadu_pd(&iptr[j]); \ + FLA_GEQRF_SMALL_CALC_NORM2(); \ + } \ + \ + if (j == slen) \ + { \ + /* load input and get its absolute values */ \ + vd2_inp = _mm_load_sd(&iptr[j]); \ + FLA_GEQRF_SMALL_CALC_NORM2(); \ + } \ + \ + /* Get all the three sums */ \ + med_sum = vd2_msum[0] + vd2_msum[1]; \ + /* Combining outlier accumulators if non-zero */ \ + if (has_outliers) \ + { \ + sml_sum = vd2_ssum[0] + vd2_ssum[1]; \ + big_sum = vd2_bsum[0] + vd2_bsum[1]; \ + FLA_GEQRF_SMALL_GET_NORM(); \ + } \ + else \ + { \ + xnorm = sqrt(med_sum); \ + } \ + \ + /* Compute Householder Reflector parameters */ \ + if (xnorm == 0.) /* Sub-diagonal elements are already zero */ \ + { \ + tau[i] = 0.; \ + beta = 0.; \ + } \ + else /* Non-zero sub-diagonal elements */ \ + { \ + /* Part 1: Compute Householder vector 'v' and tau */ \ + \ + v = &a[i + i * *lda - 1]; \ + alpha = v[1]; \ + /* check for not a number */ \ + if (alpha != alpha || xnorm != xnorm) \ + { \ + beta = alpha + xnorm; \ + } \ + else \ + { \ + doublereal px0, w, z; \ + \ + px0 = f2c_abs(alpha); \ + w = fla_max(px0, xnorm); \ + z = fla_min(px0, xnorm); \ + \ + z = z / w; \ + beta = w * sqrt(z * z + 1); \ + } \ + beta = (alpha >= 0.) ? -beta : beta; \ + \ + /* Scale-up the inputs for small norm */ \ + for (kcnt = 0; (f2c_abs(beta) < safmin && kcnt <= 20); kcnt++) \ + { \ + dscal_(&slen, &rsafmin, &v[2], &c__1); \ + beta = beta * rsafmin; \ + alpha = alpha * rsafmin; \ + } \ + \ + /* Calculate tau and v */ \ + tau[i] = (beta - alpha) / beta; \ + vnorm = 1. / (alpha - beta); \ + /* Scale current column by norm to get v */ \ + vd2_norm = _mm_set1_pd(vnorm); \ + \ + /* Normalize using SIMD */ \ + for (j = 1; j <= (slen - 1); j += 2) \ + { \ + vd2_vj1 = _mm_loadu_pd((doublereal const *) &v[j + 1]); \ + vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); \ + _mm_storeu_pd((doublereal *) &v[j + 1], vd2_vj1); \ + } \ + if (j == slen) \ + { \ + vd2_vj1 = _mm_loaddup_pd((doublereal const *) &v[j + 1]); \ + vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); \ + _mm_storel_pd((doublereal *) &v[j + 1], vd2_vj1); \ + } \ + /* Scale-down beta */ \ + for ( ; kcnt >= 1; kcnt--) \ + { \ + beta = beta * safmin; \ + } \ + } + +#define FLA_ELEM_REFLECTOR_APPLY_DSMALL(i, m, n, r, tau) \ + if (xnorm != 0.) /* Sub-diagonal elements are already zero */ \ + { \ + /* Part 2: Apply the Householder rotation */ \ + /* on the rest of the matrix */ \ + /* A = A - tau * v * v**T * A */ \ + /* = A - v * tau * (A**T * v)**T */ \ + \ + A = &r[i + (i + 1) * *lda]; \ + arows = *m - i + 1; \ + acols = *n - i; \ + v[1] = 1.; \ + ntau = -tau[i]; \ + vd2_ntau = _mm_set1_pd(ntau); \ + \ + /* work = A**T * v */ \ + for (j = 1; j <= acols; j++) /* for every column c_A of A */ \ + { \ + ac = &A[(j - 1) * *lda - 1]; \ + \ + /* Compute tmp = c_A**T . v */ \ + dtmp = 0; \ + for (k = 1; k <= (arows - 1); k += 2) \ + { \ + dtmp = dtmp + ac[k] * v[k]; \ + dtmp = dtmp + ac[k + 1] * v[k + 1]; \ + } \ + if (k == arows) \ + { \ + dtmp = dtmp + ac[k] * v[k]; \ + } \ + vd2_dtmp = _mm_set1_pd(dtmp); \ + \ + /* Compute tmp = -tau * tmp */ \ + vd2_dtmp = _mm_mul_pd(vd2_dtmp, vd2_ntau); \ + \ + /* Compute c_A + tmp * v */ \ + for (k = 1; k <= (arows - 1); k += 2) \ + { \ + /* load column elements of c_A and v */ \ + vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); \ + \ + /* mul by dtmp, add and store */ \ + vd2_inp = _mm_fmadd_pd(vd2_vj1, vd2_dtmp, vd2_inp); \ + _mm_storeu_pd((doublereal *) &ac[k], vd2_inp); \ + } \ + if (k == arows) \ + { \ + /* load single remaining element from c_A and v */ \ + vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); \ + \ + /* multiply with tau and store */ \ + vd2_inp = _mm_fmadd_pd(vd2_vj1, vd2_dtmp, vd2_inp); \ + _mm_store_sd((doublereal *) &ac[k], vd2_inp); \ + } \ + } \ + v[1] = beta; \ + } + +#define FLA_ELEM_REFLECTOR_GENERATE_DLARGE(i, m, n, tau) \ + /* calculate norm of sub-diagonal elements in current column */ \ + med_sum = sml_sum = big_sum = 0.; \ + vd4_sth = _mm256_set1_pd(thres_sml); \ + vd4_bth = _mm256_set1_pd(thres_big); \ + vd4_sscl = _mm256_set1_pd(scale_sml); \ + vd4_bscl = _mm256_set1_pd(scale_big); \ + \ + vd4_msum = _mm256_setzero_pd(); \ + vd4_ssum = _mm256_setzero_pd(); \ + vd4_bsum = _mm256_setzero_pd(); \ + \ + /* process four inputs per iteration */ \ + for (j = 1; j <= (slen - 3); j += 4) \ + { \ + FLA_GEQRF_SMALL_CALC_NORM4(j); \ + } \ + \ + if (j <= slen) \ + { /* process remaining iterations */ \ + vd2_msum = _mm_setzero_pd(); \ + vd2_ssum = _mm_setzero_pd(); \ + vd2_bsum = _mm_setzero_pd(); \ + \ + /* process two inputs per iteration */ \ + for ( ; j <= slen; j++) \ + { \ + vd2_inp = _mm_loaddup_pd(&iptr[j]); \ + FLA_GEQRF_SMALL_CALC_NORM2(); \ + } \ + /* Get all the three sums */ \ + med_sum = vd4_msum[0] + vd4_msum[1] + vd4_msum[2] \ + + vd4_msum[3] + vd2_msum[0]; \ + sml_sum = vd4_ssum[0] + vd4_ssum[1] + vd4_ssum[2] \ + + vd4_ssum[3] + vd2_ssum[0]; \ + big_sum = vd4_bsum[0] + vd4_bsum[1] + vd4_bsum[2] \ + + vd4_bsum[3] + vd2_bsum[0]; \ + } \ + else \ + { \ + /* Get all the three sums in case of no remaining iterations */ \ + med_sum = vd4_msum[0] + vd4_msum[1] + vd4_msum[2] + vd4_msum[3]; \ + sml_sum = vd4_ssum[0] + vd4_ssum[1] + vd4_ssum[2] + vd4_ssum[3]; \ + big_sum = vd4_bsum[0] + vd4_bsum[1] + vd4_bsum[2] + vd4_bsum[3]; \ + } \ + \ + /* Combining outlier accumulators if non-zero */ \ + if (has_outliers) \ + { \ + FLA_GEQRF_SMALL_GET_NORM(); \ + } \ + else \ + { \ + xnorm = sqrt(med_sum); \ + } \ + \ + /* Compute Householder Reflector parameters */ \ + if (xnorm == 0.) /* Sub-diagonal elements are already zero */ \ + { \ + tau[i] = 0.; \ + beta = 0.; \ + } \ + else /* Non-zero sub-diagonal elements */ \ + { \ + /* Part 1: Compute Householder vector 'v' and tau */ \ + \ + v = &a[i + i * *lda - 1]; \ + alpha = v[1]; \ + \ + /* Compute Householder rotated vector */ \ + if (alpha != alpha || xnorm != xnorm) /* check for not a number */ \ + { \ + beta = alpha + xnorm; \ + } \ + else \ + { \ + doublereal px0, w, z; \ + \ + px0 = f2c_abs(alpha); \ + w = fla_max(px0, xnorm); \ + z = fla_min(px0, xnorm); \ + \ + z = z / w; \ + beta = w * sqrt(z * z + 1); \ + } \ + beta = (alpha >= 0.) ? -beta : beta; \ + \ + /* Scale-up the inputs for small norm */ \ + for (kcnt = 0; (f2c_abs(beta) < safmin && kcnt <= 20); kcnt++) \ + { \ + dscal_(&slen, &rsafmin, &v[2], &c__1); \ + beta = beta * rsafmin; \ + alpha = alpha * rsafmin; \ + } \ + \ + /* Calculate tau and v */ \ + tau[i] = (beta - alpha) / beta; \ + vnorm = 1. / (alpha - beta); \ + /* Scale current column by norm to get v */ \ + vd4_norm = _mm256_set1_pd(vnorm); \ + \ + /* Normalize using SIMD */ \ + for (j = 1; j <= (slen - 3); j += 4) \ + { \ + vd4_vj = _mm256_loadu_pd((doublereal const *) &v[j + 1]); \ + vd4_vj = _mm256_mul_pd(vd4_vj, vd4_norm); \ + _mm256_storeu_pd((doublereal *) &v[j + 1], vd4_vj); \ + } \ + /* Remaining iterations through 128-bit SIMD */ \ + if (j <= slen) \ + { \ + vd2_norm = _mm_set1_pd(vnorm); \ + for ( ; j <= (slen - 1); j += 2) \ + { \ + vd2_vj1 = _mm_loadu_pd((doublereal const *) &v[j + 1]); \ + vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); \ + _mm_storeu_pd((doublereal *) &v[j + 1], vd2_vj1); \ + } \ + if (j == slen) \ + { \ + vd2_vj1 = _mm_loaddup_pd((doublereal const *) &v[j + 1]); \ + vd2_vj1 = _mm_mul_pd(vd2_vj1, vd2_norm); \ + _mm_storel_pd((doublereal *) &v[j + 1], vd2_vj1); \ + } \ + } \ + /* Scale-down beta */ \ + for ( ; kcnt >= 1; kcnt--) \ + { \ + beta = beta * safmin; \ + } \ + } + +#define FLA_ELEM_REFLECTOR_APPLY_DLARGE(i, m, n, r, ldr, tau) \ + if (xnorm != 0.) /* Sub-diagonal elements are already zero */ \ + { \ + /* Part 2: Apply the Householder rotation */ \ + /* on the rest of the matrix */ \ + /* A = A - tau * v * v**T * A */ \ + /* = A - v * tau * (A**T * v)**T */ \ + \ + A = &r[i + (i + 1) * *ldr]; \ + arows = *m - i + 1; \ + acols = *n - i; \ + v[1] = 1.; \ + ntau = -tau[i]; \ + vd2_ntau = _mm_set1_pd(ntau); \ + \ + /* work = A**T * v */ \ + for (j = 1; j <= acols; j++) /* for every column c_A of A */ \ + { \ + ac = &A[(j - 1) * *ldr - 1]; \ + vd2_dtmp = _mm_setzero_pd(); \ + vd4_dtmp = _mm256_setzero_pd(); \ + \ + /* Compute tmp = c_A**T . v */ \ + for (k = 1; k <= (arows - 3); k += 4) \ + { \ + /* load column elements of A and v */ \ + vd4_inp = _mm256_loadu_pd((const doublereal *) &ac[k]); \ + vd4_vj = _mm256_loadu_pd((const doublereal *) &v[k]); \ + \ + /* take dot product */ \ + vd4_dtmp = _mm256_fmadd_pd(vd4_inp, vd4_vj, vd4_dtmp); \ + } \ + if (k < arows) \ + { \ + /* load column elements of A and v */ \ + vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); \ + \ + /* take dot product */ \ + vd2_dtmp = _mm_fmadd_pd(vd2_inp, vd2_vj1, vd2_dtmp); \ + k += 2; \ + } \ + if (k == arows) \ + { \ + /* load single remaining element from c_A and v */ \ + vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); \ + \ + /* take dot product */ \ + vd2_dtmp = _mm_fmadd_pd(vd2_inp, vd2_vj1, vd2_dtmp); \ + } \ + /* Horizontal add of dtmp */ \ + vd2_ltmp = _mm256_castpd256_pd128(vd4_dtmp); \ + vd2_htmp = _mm256_extractf128_pd(vd4_dtmp, 0x1); \ + \ + vd2_dtmp = _mm_add_pd(vd2_dtmp, vd2_ltmp); \ + vd2_dtmp = _mm_add_pd(vd2_dtmp, vd2_htmp); \ + vd2_dtmp = _mm_hadd_pd(vd2_dtmp, vd2_dtmp); \ + \ + /* Compute tmp = - tau * tmp */ \ + vd2_dtmp = _mm_mul_pd(vd2_dtmp, vd2_ntau); \ + vd4_dtmp = _mm256_castpd128_pd256(vd2_dtmp); \ + vd4_dtmp = _mm256_insertf128_pd(vd4_dtmp, vd2_dtmp, 0x1); \ + \ + /* alternate for above 2 instructions which do not */ \ + /* compile for older gcc versions (7 and below). */ \ + /* Both will be same in terms of latency though */ \ + /* vd4_dtmp = _mm256_set_m128d(vd2_dtmp, vd2_dtmp); */ \ + \ + /* Compute c_A + tmp * v */ \ + for (k = 1; k <= (arows - 3); k += 4) \ + { \ + /* load column elements of c_A and v */ \ + vd4_inp = _mm256_loadu_pd((const doublereal *) &ac[k]); \ + vd4_vj = _mm256_loadu_pd((const doublereal *) &v[k]); \ + \ + /* mul by dtmp, add and store */ \ + vd4_inp = _mm256_fmadd_pd(vd4_dtmp, vd4_vj, vd4_inp); \ + _mm256_storeu_pd((doublereal *) &ac[k], vd4_inp); \ + } \ + if (k < arows) \ + { \ + /* load column elements of c_A and v */ \ + vd2_inp = _mm_loadu_pd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_loadu_pd((const doublereal *) &v[k]); \ + \ + /* mul by dtmp, add and store */ \ + vd2_inp = _mm_fmadd_pd(vd2_dtmp, vd2_vj1, vd2_inp); \ + _mm_storeu_pd((doublereal *) &ac[k], vd2_inp); \ + k += 2; \ + } \ + if (k == arows) \ + { \ + /* load single remaining element from c_A and v */ \ + vd2_inp = _mm_load_sd((const doublereal *) &ac[k]); \ + vd2_vj1 = _mm_load_sd((const doublereal *) &v[k]); \ + \ + /* mul by dtmp, add and store */ \ + vd2_inp = _mm_fmadd_pd(vd2_dtmp, vd2_vj1, vd2_inp); \ + _mm_storel_pd((doublereal *) &ac[k], vd2_inp); \ + } \ + } \ + v[1] = beta; \ + } + +#define FLA_BIDIAGONALIZE_SMALL(nr, nc) \ + for (i = 1; i <= nr; i++) \ + { \ + slen = nr - i; \ + /* input address */ \ + doublereal *iptr; \ + integer has_outliers = 0; \ + \ + /* Annihilate elements in current column */ \ + iptr = (doublereal *) &a[i + 1 + i * *lda - 1]; \ + if (slen == 0) \ + { \ + tauq[i] = 0.; \ + beta = 0.; \ + } \ + else if (slen < 4) \ + { \ + /* Generate elementary reflector to annihilate \ + * elements below diagonal A(i+1:nr,i) */ \ + FLA_ELEM_REFLECTOR_GENERATE_DSMALL(i, &nr, &nc, tauq); \ + /* Apply the reflector on A(i:nr,i+1:nc) from the left */ \ + FLA_ELEM_REFLECTOR_APPLY_DSMALL(i, &nr, &nc, a, tauq); \ + } \ + else \ + { \ + /* Generate elementary reflector to annihilate \ + * elements below diagonal A(i+1:nr,i) */ \ + FLA_ELEM_REFLECTOR_GENERATE_DLARGE(i, &nr, &nc, tauq); \ + /* Apply the reflector on A(i:nr,i+1:nc) from the left */ \ + FLA_ELEM_REFLECTOR_APPLY_DLARGE(i, &nr, &nc, a, lda, tauq); \ + } \ + s[i] = *iptr; \ + \ + /* Annihilate elements in current row */ \ + beta = 0.; \ + rlen = nc - i - 1; \ + tau = taup; \ + if (rlen <= 0) \ + { \ + tau[i] = 0.; \ + } \ + else \ + { \ + /* Generate elementary reflector to annihilate */ \ + /* elements A(i,i+2:nr) */ \ + \ + /* Compute norm2 */ \ + xnorm = dnrm2_(&rlen, &iptr[2 * *lda], lda); \ + if (xnorm == 0.) \ + { \ + tau[i] = 0.; \ + } \ + else \ + { \ + knt = 0; \ + v = iptr; \ + alpha = v[*lda]; \ + d__1 = dlapy2_(&v[*lda], &xnorm); \ + beta = -d_sign(&d__1, &alpha); \ + if (f2c_abs(beta) < safmin) \ + { \ + for (knt = 0; f2c_abs(beta) < safmin && knt < 20; knt++) \ + { \ + i__1 = *n - 1; \ + dscal_(&i__1, &rsafmin, &v[2 * *lda], lda); \ + beta *= rsafmin; \ + alpha *= rsafmin; \ + } \ + /* New BETA is at most 1, at least SAFMIN */ \ + i__1 = rlen; \ + xnorm = dnrm2_(&i__1, &v[2 * *lda], lda); \ + d__1 = dlapy2_(&alpha, &xnorm); \ + beta = -d_sign(&d__1, &alpha); \ + } \ + tau[i] = (beta - alpha) / beta; \ + i__1 = rlen; \ + d__1 = 1. / (alpha - beta); \ + dscal_(&i__1, &d__1, &v[2 * *lda], lda); \ + for (j = 1; j <= knt; ++j) \ + { \ + beta *= safmin; \ + } \ + \ + /* Apply the reflector on A(i+1:nr,i+1:nc) from the right */ \ + \ + /* for every row ac of A(i+1:nr,i+1:nc) */ \ + ac = iptr; \ + v[*lda] = 1; \ + for (j = 1; j <= slen; j++) \ + { \ + dtmp = 0; \ + /* w = (ac .* v) */ \ + for (k = 1; k <= rlen + 1; k++) \ + { \ + dtmp = dtmp + ac[j + k * *lda] * v[k * *lda]; \ + } \ + \ + /* (ac .* v) * tau */ \ + dtmp = dtmp * tau[i]; \ + \ + /* ac = ac - ac * dtmp */ \ + for (k = 1; k <= rlen + 1; k++) \ + { \ + ac[j + k * *lda] = ac[j + k * *lda] - v[k * *lda] * dtmp; \ + } \ + } \ + v[*lda] = beta; \ + } \ + } \ + e[i] = iptr[*lda]; \ + } +#endif diff --git a/src/lapack/x86/avx2/fla_dgesvd_nn_small10_avx2.c b/src/lapack/x86/avx2/fla_dgesvd_nn_small10_avx2.c new file mode 100644 index 000000000..0289f8181 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgesvd_nn_small10_avx2.c @@ -0,0 +1,70 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_dgesvd_nn_small10_avx2.c + * @brief DGESVD Small path (path 10) + * */ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +double d_sign(doublereal *, doublereal *); + +void fla_dgesvd_nn_small10_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info) +{ + /* Declare and init local variables */ + FLA_GEQRF_INIT_DSMALL(); + + doublereal d__1; + doublereal *tau, *tauq, *taup; + doublereal *e; + doublereal dum[1]; + + integer c__0 = 0; + integer c__1 = 1; + + integer iu, ie, iwork; + integer itau, itauq, itaup; + integer i__1, rlen, knt; + + integer ldu_val = 0; + integer *ldu = &ldu_val; + + /* indices for partitioning work buffer */ + iu = 1; + itau = iu + *m * *ldu; + ie = itau + *m; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + + /* parameter adjustments */ + a -= (1 + *lda); + --s; + --work; + + /* work buffer distribution */ + e = &work[ie - 1]; + tauq = &work[itauq - 1]; + taup = &work[itaup - 1]; + + /* Upper Bidiagonalization */ + FLA_BIDIAGONALIZE_SMALL(*m, *n); + + /* Compute Singular Values */ + lapack_dbdsqr("U", n, &c__0, &c__0, &c__0, &s[1], &e[1], + NULL, &c__1, + NULL, &c__1, + dum, &c__1, + &work[iwork], info); + + return; +} +#endif diff --git a/src/lapack/x86/avx2/fla_dgesvd_nn_small1T_avx2.c b/src/lapack/x86/avx2/fla_dgesvd_nn_small1T_avx2.c new file mode 100644 index 000000000..41046b0c5 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgesvd_nn_small1T_avx2.c @@ -0,0 +1,71 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_dgesvd_nn_small1T_avx2_.c + * @brief DGESVD Small path (path 1T) + * */ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#ifdef FLA_ENABLE_AMD_OPT + +double d_sign(doublereal *, doublereal *); + +void fla_dgesvd_nn_small1T_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info) +{ + /* Declare and init local variables */ + FLA_GEQRF_INIT_DSMALL(); + + doublereal d__1; + doublereal *tau, *tauq, *taup; + doublereal *e; + doublereal dum[1]; + + integer c__0 = 0; + integer c__1 = 1; + + integer iu, ie, iwork; + integer itau, itauq, itaup; + integer i__1, rlen, knt; + + integer ldu_val = 0; + integer *ldu = &ldu_val; + + /* indices for partitioning work buffer */ + iu = 1; + itau = iu + *m * *ldu; + ie = itau + *m; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + + /* parameter adjustments */ + a -= (1 + *lda); + --s; + --work; + + /* work buffer distribution */ + e = &work[ie - 1]; + tauq = &work[itauq - 1]; + taup = &work[itaup - 1]; + + /* Upper Bidiagonalization */ + FLA_BIDIAGONALIZE_SMALL(*m, *m); + + /* Compute Singular Values */ + lapack_dbdsqr("U", m, &c__0, &c__0, &c__0, &s[1], &e[1], + NULL, &c__1, + NULL, &c__1, + dum, &c__1, + &work[iwork], info); + + return; +} +#endif + diff --git a/src/lapack/x86/avx2/fla_dgesvd_small6T_avx2.c b/src/lapack/x86/avx2/fla_dgesvd_small6T_avx2.c new file mode 100644 index 000000000..eec75c3f9 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgesvd_small6T_avx2.c @@ -0,0 +1,235 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_dgesvd_small6T_avx2_.c + * @brief DGESVD Small path (path 6T) + * without the LQ Factorization. + * */ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +double d_sign(doublereal *, doublereal *); + +static integer c__0 = 0; +static integer c__1 = 1; + +/* SVD for small fat-matrices with LQ factorization + * already computed + */ +void fla_dgesvd_small6T_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *ql, integer *ldql, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info) +{ + /* Declare and init local variables */ + FLA_GEQRF_INIT_DSMALL(); + + integer iu, ie, iwork; + integer itau, itauq, itaup; + integer i__1, rlen, knt; + + doublereal *tau, *tauq, *taup; + doublereal *e, *vtau, *avt; + doublereal stau, d__1; + doublereal dum[1]; + + /* indices for partitioning work buffer */ + iu = 1; + itau = iu + *m * *lda; + ie = itau + *m; + itauq = ie + *m; + itaup = itauq + *m; + iwork = itaup + *m; + + /* parameter adjustments */ + a -= (1 + *lda); + u -= (1 + *ldu); + vt -= (1 + *ldvt); + ql -= (1 + *ldql); + --s; + --work; + + /* work buffer distribution */ + e = &work[ie - 1]; + tauq = &work[itauq - 1]; + taup = &work[itaup - 1]; + + /* Upper Bidiagonalization */ + FLA_BIDIAGONALIZE_SMALL(*m, *m); + + for (i = 1; i <= *m; i++) + for (j = 1; j <= *n; j++) + vt[i + j * *ldvt] = 0.; + /* Generate Qr (from bidiag) in vt from work[iu] (a here) */ + if (*m > 2) + { + /* iteration corresponding to (m - 2) HH[m-2] */ + stau = taup[*m - 2]; + d__1 = a[*m - 2 + *m * *lda]; + dtmp = - (stau * d__1); /* tau * v2 */ + + vt[*m - 1 + (*m - 1) * *ldvt] = 1.0 - stau; /* 1 - tau */ + vt[*m + (*m - 1) * *ldvt] = dtmp; /* tau * v2 */ + vt[*m - 1 + *m * *ldvt] = dtmp; /* tau * v2 */ + vt[*m + *m * *ldvt] = 1.0 + (dtmp * d__1); /* 1 - tau * v2^2 */ + + /* for HH vectors [m-3:1] */ + for (i = *m - 3; i >= 1; i--) + { + stau = - taup[i]; + + /* Scale row i by -tau and dlarf for rest of the rows */ + for (j = i + 2; j <= *m; j++) + { + vt[i + 1 + j * *ldvt] = stau * a[i + j * *lda]; + + /* GEMV part of the dlarf excluding zero first column */ + dtmp = 0.; + for (k = i + 2; k <= *m; k++) + { + dtmp = dtmp + vt[j + k * *ldvt] * a[i + k * *lda]; + } + vt[j + (i + 1) * *ldvt] = stau * dtmp; + } + vt[i + 1 + (i + 1) * *ldvt] = 1.0 + stau; + + for (j = i + 2; j <= *m; j++) + { + for (k = i + 2; k <= *m; k++) + { + vt[j + k * *ldvt] = vt[j + k * *ldvt] + a[i + k * *lda] * + vt[j + (i + 1) * *ldvt]; + } + } + } + } + + /* Generate Ql (from bidiag) in u from a */ + + if (*m > 1) + { + /* iteration corresponding to (m - 1) HH(m-1) */ + stau = tauq[*m - 1]; + d__1 = a[*m + (*m - 1) * *lda]; + dtmp = - (stau * d__1); + + u[*m - 1 + (*m - 1) * *ldu] = 1.0 - stau; /* 1 - tau */ + u[*m + (*m - 1) * *ldu] = dtmp; /* tau * v2 */ + u[*m - 1 + *m * *ldu] = dtmp; /* tau * v2 */ + u[*m + *m * *ldu] = 1.0 + (dtmp * d__1); /* 1 - tau * v2^2 */ + } + else + { + u[1 + *ldu] = 1.0; + } + + /* for HH vectors [m-2:1] */ + for (i = *m - 2; i >= 1; i--) + { + stau = - tauq[i]; + + /* scale col i by -tau and dlarf for rest of the columns */ + for (j = i + 1; j <= *m; j++) + { + u[j + i * *ldu] = stau * a[j + i * *lda]; + + /* GEMV part of dlarf excluding zero first row */ + dtmp = 0; + for (k = i + 1; k <= *m; k++) + { + dtmp = dtmp + u[k + j * *ldu] * a[k + i * *lda]; + } + u[i + j * *ldu] = stau * dtmp; + } + u[i + i * *ldu] = 1.0 + stau; + + for (j = i + 1; j <= *m; j++) + { + for (k = i + 1; k <= *m; k++) + { + u[k + j * *ldu] = u[k + j * *ldu] + a[k + i * *lda] * u[i + j * *ldu]; + } + } + } + vt[1 + *ldvt] = 1.0; + + lapack_dbdsqr("U", m, m, m, &c__0, &s[1], &e[1], + &vt[1 + *ldvt], ldvt, + &u[1 + *ldu], ldu, + dum, &c__1, + &work[iwork], info); + + tau = &work[itau - 1]; + vtau = tau + *m; + avt = vtau + *n; + + /* Apply HH from LQ factorization (ql) on vt from right */ + + /* First Iteration corresponding to HH(m) */ + i = *m; + for (j = i + 1; j <= *n; j++) + { + /* - ql[i][j] * tau[i] */ + d__1 = - ql[i + j * *ldql] * tau[i]; + + /* vt[1:m, j] = d__1 * vt[1:m, j] */ + for (k = 1; k <= *m; k++) + { + vt[k + j * *ldvt] = d__1 * vt[k + i * *ldvt]; + } + } + /* vt[m, 1:m] = vt[m, 1:m] * (1 - tau) */ + d__1 = 1 - tau[i]; + for (j = 1; j <= *m; j++) + { + vt[j + *m * *ldvt] = vt[j + *m * *ldvt] * d__1; + } + + /* Second Iteration onwards */ + for (i = *m - 1; i >= 1; i--) + { + /* Scale HH vector by tau, store in vtau */ + vtau[1] = - tau[i]; + for (j = 2; j <= (*n - i + 1); j++) + { + vtau[j] = vtau[1] * ql[i + (j + i - 1) * *ldql]; + } + + /* avt = Vt * vtau (gemv) */ + for (j = 1; j <= *m; j++) + { + avt[j] = 0.; + } + for (j = 1; j <= (*n - i + 1); j++) /* for every column of Vt */ + { + for (k = 1; k <= *m; k++) /* Scale the col and accumulate */ + { + avt[k] = avt[k] + vtau[j] * vt[k + (j + i - 1) * *ldvt]; + } + } + + /* Vt = Vt + avt * v' (ger) */ + for (k = 1; k <= *m; k++) + { + vt[k + i * *ldvt] = vt[k + i * *ldvt] + avt[k]; + } + for (j = 2; j <= (*n - i + 1); j++) + { + for (k = 1; k <= *m; k++) + { + vt[k + (j + i - 1) * *ldvt] = vt[k + (j + i - 1) * *ldvt] + avt[k] * ql[i + (j + i - 1) * *ldql]; + } + } + } + + return; +} +#endif diff --git a/src/lapack/x86/avx2/fla_dgesvd_small6_avx2.c b/src/lapack/x86/avx2/fla_dgesvd_small6_avx2.c new file mode 100644 index 000000000..7c544fef1 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgesvd_small6_avx2.c @@ -0,0 +1,208 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_dgesvd_small6_avx2_.c + * @brief DGESVD Small path (path 6) + * without the LQ Factorization. + * */ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +double d_sign(doublereal *, doublereal *); + +static integer c__0 = 0; +static integer c__1 = 1; + +/* SVD for small fat-matrices with LQ factorization + * already computed + */ +void fla_dgesvd_small6_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *qr, integer *ldqr, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info) +{ + /* Declare and init local variables */ + FLA_GEQRF_INIT_DSMALL(); + + integer iu, ie, iwork; + integer itau, itauq, itaup; + integer i__1, rlen, knt; + integer ni; + + doublereal *tau, *tauq, *taup; + doublereal *e, *au; + doublereal stau, d__1; + doublereal dum[1]; + + /* indices for partitioning work buffer */ + iu = 1; + itau = iu + *n * *lda; + ie = itau + *n; + itauq = ie + *n; + itaup = itauq + *n; + iwork = itaup + *n; + + /* parameter adjustments */ + a -= (1 + *lda); + u -= (1 + *ldu); + vt -= (1 + *ldvt); + qr -= (1 + *ldqr); + v = &dum[-1]; + --s; + --work; + + /* work buffer distribution */ + e = &work[ie - 1]; + tauq = &work[itauq - 1]; + taup = &work[itaup - 1]; + + /* Upper Bidiagonalization */ + FLA_BIDIAGONALIZE_SMALL(*n, *n); + + for (i = 1; i <= *n; i++) + for (j = 1; j <= *n; j++) + vt[i + j * *ldvt] = 0.; + /* Generate Qr (from bidiag) in vt from work[iu] (a here) */ + if (*n > 2) + { + /* iteration corresponding to (n - 2) HH[n-2] */ + stau = taup[*n - 2]; + d__1 = a[*n - 2 + *n * *lda]; + dtmp = - (stau * d__1); /* tau * v2 */ + + vt[*n - 1 + (*n - 1) * *ldvt] = 1.0 - stau; /* 1 - tau */ + vt[*n + (*n - 1) * *ldvt] = dtmp; /* tau * v2 */ + vt[*n - 1 + *n * *ldvt] = dtmp; /* tau * v2 */ + vt[*n + *n * *ldvt] = 1.0 + (dtmp * d__1); /* 1 - tau * v2^2 */ + + /* for HH vectors [n-3:1] */ + for (i = *n - 3; i >= 1; i--) + { + stau = - taup[i]; + + /* Scale row i by -tau and dlarf for rest of the rows */ + for (j = i + 2; j <= *n; j++) + { + vt[i + 1 + j * *ldvt] = stau * a[i + j * *lda]; + + /* GEMV part of the dlarf excluding zero first column */ + dtmp = 0.; + for (k = i + 2; k <= *n; k++) + { + dtmp = dtmp + vt[j + k * *ldvt] * a[i + k * *lda]; + } + vt[j + (i + 1) * *ldvt] = stau * dtmp; + } + vt[i + 1 + (i + 1) * *ldvt] = 1.0 + stau; + + for (j = i + 2; j <= *n; j++) + { + for (k = i + 2; k <= *n; k++) + { + vt[j + k * *ldvt] = vt[j + k * *ldvt] + a[i + k * *lda] * + vt[j + (i + 1) * *ldvt]; + } + } + } + } + + /* Generate Ql (from bidiag) in u from a */ + + if (*n > 1) + { + /* iteration corresponding to (n - 1) HH(n-1) */ + stau = tauq[*n - 1]; + d__1 = a[*n + (*n - 1) * *lda]; + dtmp = - (stau * d__1); + + u[*n - 1 + (*n - 1) * *ldu] = 1.0 - stau; /* 1 - tau */ + u[*n + (*n - 1) * *ldu] = dtmp; /* tau * v2 */ + u[*n - 1 + *n * *ldu] = dtmp; /* tau * v2 */ + u[*n + *n * *ldu] = 1.0 + (dtmp * d__1); /* 1 - tau * v2^2 */ + } + else + { + u[1 + *ldu] = 1.0; + } + + /* for HH vectors [n-2:1] */ + for (i = *n - 2; i >= 1; i--) + { + stau = - tauq[i]; + + /* scale col i by -tau and dlarf for rest of the columns */ + for (j = i + 1; j <= *n; j++) + { + u[j + i * *ldu] = stau * a[j + i * *lda]; + + /* GEMV part of dlarf excluding zero first row */ + dtmp = 0; + for (k = i + 1; k <= *n; k++) + { + dtmp = dtmp + u[k + j * *ldu] * a[k + i * *lda]; + } + u[i + j * *ldu] = stau * dtmp; + } + u[i + i * *ldu] = 1.0 + stau; + + for (j = i + 1; j <= *n; j++) + { + for (k = i + 1; k <= *n; k++) + { + u[k + j * *ldu] = u[k + j * *ldu] + a[k + i * *lda] * u[i + j * *ldu]; + } + } + } + vt[1 + *ldvt] = 1.0; + + lapack_dbdsqr("U", n, n, n, &c__0, &s[1], &e[1], + &vt[1 + *ldvt], ldvt, + &u[1 + *ldu], ldu, + dum, &c__1, + &work[iwork], info); + + /* Apply HH from QR factorization (qr) on vt from left */ + + tau = &work[itau - 1]; + /* First Iteration corresponding to HH(n) */ + i = *n; + for (j = 1; j <= *n; j++) + { + /* - u[i][j] * tau[i] */ + d__1 = - u[i + j * *ldu] * tau[i]; + + /* u[n+1:m, j] = d__1 * u[n+1:m, j] */ + for (k = *n + 1; k <= *m; k++) + { + u[k + j * *ldu] = d__1 * qr[k + *n * *ldqr]; + } + } + /* u[m, 1:m] = u[m, 1:m] * (1 - tau) */ + d__1 = 1 - tau[i]; + for (j = 1; j <= *n; j++) + { + u[*n + j * *ldu] = u[*n + j * *ldu] * d__1; + } + + /* Second Iteration onwards */ + beta = 0; + for (i = *n - 1; i >= 1; i--) + { + ni = *n + i; + + au = &u[-i * *ldqr]; + v = &qr[i + i * *ldqr - 1]; + FLA_ELEM_REFLECTOR_APPLY_DLARGE(i, m, &ni, au, ldqr, tau); + } + + return; +} +#endif diff --git a/src/lapack/x86/avx2/fla_dgetrf_avx2.c b/src/lapack/x86/avx2/fla_dgetrf_avx2.c deleted file mode 100644 index 0847a0c55..000000000 --- a/src/lapack/x86/avx2/fla_dgetrf_avx2.c +++ /dev/null @@ -1,130 +0,0 @@ -/****************************************************************************** -* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. -*******************************************************************************/ - -#include "FLAME.h" - -#ifdef FLA_ENABLE_AMD_OPT - -/* - * LU with partial pivoting for tiny matrices - * - * All the computations are done inline without using - * corresponding BLAS APIs to reduce function overheads. - */ -integer fla_lu_piv_small_d_avx2( integer *m, integer *n, - doublereal *a, integer *lda, - integer *ipiv, - integer *info) -{ - integer mi, ni; - integer i, j, i_1, lda_t, b_off, y_off; - - doublereal p_val, max_val, t_val; - doublereal *acur, *apiv, *asrc; - integer p_idx; - __m256d result[4], tempY[4], tempb[4], tempx, p_val4; - integer min_m_n = fla_min(*m, *n); - lda_t = *lda; - - for( i = 0; i < min_m_n; i++ ) - { - mi = *m - i; - ni = *n - i; - - acur = &a[i + lda_t * i]; - - /* Find the pivot element */ - max_val = 0; - p_idx = i; - for( i_1 = 0; i_1 < mi; i_1++ ) - { - t_val = acur[i_1]; - t_val = ( t_val < 0.0 ) ? -t_val : t_val; - if( t_val > max_val ) - { - max_val = t_val; - p_idx = i + i_1; - } - } - - apiv = a + p_idx; - asrc = a + i; - ipiv[i] = p_idx + 1; - - /* Swap rows and calculate a column of L */ - if( max_val != 0.0 ) - { - /* Swap entire rows */ - if( p_idx != i) - { - for( i_1 = 0; i_1 < *n; i_1++ ) - { - t_val = apiv[i_1 * lda_t]; - apiv[i_1 * *lda] = asrc[i_1 * lda_t]; - asrc[i_1 * *lda] = t_val; - } - } - - /* Calculate scalefactors (L) & update trailing matrix */ - p_val = *acur; - p_val = 1 / p_val; - p_val4 = _mm256_set1_pd(p_val); - for( i_1 = 1; i_1 < mi-3; i_1+=4 ) - { - tempx = _mm256_mul_pd(_mm256_loadu_pd(&acur[i_1]), p_val4); - _mm256_storeu_pd(&acur[i_1], tempx); - - for( j = 1; j < ni-3; j+=4 ) - { - b_off = j * lda_t; - y_off = i_1 + j * lda_t; - tempb[0] = _mm256_broadcast_sd(&acur[b_off]); - tempb[1] = _mm256_broadcast_sd(&acur[b_off] + 1*lda_t); - tempb[2] = _mm256_broadcast_sd(&acur[b_off] + 2*lda_t); - tempb[3] = _mm256_broadcast_sd(&acur[b_off] + 3*lda_t); - tempY[0] = _mm256_loadu_pd(&acur[y_off]); - tempY[1] = _mm256_loadu_pd(&acur[y_off] + 1*lda_t); - tempY[2] = _mm256_loadu_pd(&acur[y_off] + 2*lda_t); - tempY[3] = _mm256_loadu_pd(&acur[y_off] + 3*lda_t); - /* Y := Y - b * x */ - result[0] = _mm256_fnmadd_pd(tempb[0], tempx, tempY[0]); - result[1] = _mm256_fnmadd_pd(tempb[1], tempx, tempY[1]); - result[2] = _mm256_fnmadd_pd(tempb[2], tempx, tempY[2]); - result[3] = _mm256_fnmadd_pd(tempb[3], tempx, tempY[3]); - _mm256_storeu_pd(&acur[y_off], result[0]); - _mm256_storeu_pd(( &acur[y_off] + 1 * lda_t), result[1]); - _mm256_storeu_pd(( &acur[y_off] + 2 * lda_t), result[2]); - _mm256_storeu_pd(( &acur[y_off] + 3 * lda_t), result[3]); - } - /* remining inner loop updation*/ - for (; j < ni; j++) - { - b_off = j * lda_t; - y_off = i_1 + j * lda_t; - tempb[0] = _mm256_broadcast_sd(&acur[b_off]); - tempY[0] = _mm256_loadu_pd(&acur[y_off]); - result[0] = _mm256_fnmadd_pd(tempb[0], tempx, tempY[0]); - _mm256_storeu_pd(&acur[y_off], result[0]); - } - } - /* remining outer loop updation */ - for (; i_1 < mi; i_1++) - { - acur[i_1] = acur[i_1] * p_val; - for (j = 1; j < ni; j++) - { - acur[i_1 + j * lda_t] = acur[i_1 + j * lda_t] - acur[j * lda_t] * acur[i_1]; - } - } - } - else - { - *info = ( *info == 0 ) ? p_idx + 1 : *info; - } - } - - - return *info; -} -#endif \ No newline at end of file diff --git a/src/lapack/x86/avx2/fla_dgetrf_small_avx2.c b/src/lapack/x86/avx2/fla_dgetrf_small_avx2.c new file mode 100644 index 000000000..aff4d33a2 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgetrf_small_avx2.c @@ -0,0 +1,81 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +/* + * LU with partial pivoting for tiny matrices + * + * All the computations are done inline without using + * corresponding BLAS APIs to reduce function overheads. + */ +integer fla_dgetrf_small_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + integer *ipiv, + integer *info) +{ + integer mi, ni; + integer i, i_1, lda_t; + + doublereal max_val, t_val; + doublereal *acur, *apiv, *asrc; + integer p_idx; + integer min_m_n = fla_min(*m, *n); + lda_t = *lda; + + for( i = 0; i < min_m_n; i++ ) + { + mi = *m - i; + ni = *n - i; + + acur = &a[i + lda_t * i]; + + /* Find the pivot element */ + max_val = 0; + p_idx = i; + for( i_1 = 0; i_1 < mi; i_1++ ) + { + t_val = acur[i_1]; + t_val = ( t_val < 0.0 ) ? -t_val : t_val; + if( t_val > max_val ) + { + max_val = t_val; + p_idx = i + i_1; + } + } + + apiv = a + p_idx; + asrc = a + i; + ipiv[i] = p_idx + 1; + + /* Swap rows and calculate a column of L */ + if( max_val != 0.0 ) + { + /* Swap entire rows */ + if( p_idx != i) + { + for( i_1 = 0; i_1 < *n; i_1++ ) + { + t_val = apiv[i_1 * lda_t]; + apiv[i_1 * *lda] = asrc[i_1 * lda_t]; + asrc[i_1 * *lda] = t_val; + } + } + + /* Calculate scalefactors (L) & update trailing matrix */ + fla_lu_piv_small_d_update_tr_matrix_avx2(1, mi, ni, acur, *lda); + } + else + { + *info = ( *info == 0 ) ? p_idx + 1 : *info; + } + } + + + return *info; +} +#endif diff --git a/src/lapack/x86/avx2/fla_dgetrs_small_trsm_ll_avx2.c b/src/lapack/x86/avx2/fla_dgetrs_small_trsm_ll_avx2.c new file mode 100644 index 000000000..30aa93375 --- /dev/null +++ b/src/lapack/x86/avx2/fla_dgetrs_small_trsm_ll_avx2.c @@ -0,0 +1,1170 @@ +/****************************************************************************** + * Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. + *******************************************************************************/ + +/*! @file fla_dgetrs_small_trsm_ll_avx2.c + * @brief solves a system of linear equations: A * X = B or A**T * X = B in AVX2. + * */ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +#define TRANSPOSE_4x4(r_1, r_2, r_3, r_4) \ + t_reg[0] = _mm256_unpacklo_pd(b_reg[r_1], b_reg[r_2]); \ + t_reg[1] = _mm256_unpacklo_pd(b_reg[r_3], b_reg[r_4]); \ + b_reg[r_1] = _mm256_unpackhi_pd(b_reg[r_1], b_reg[r_2]); \ + b_reg[r_2] = _mm256_unpackhi_pd(b_reg[r_3], b_reg[r_4]); \ + b_reg[r_4] = _mm256_permute2f128_pd(b_reg[r_1], b_reg[r_2], 0x31); \ + b_reg[r_2] = _mm256_permute2f128_pd(b_reg[r_1], b_reg[r_2], 0x20); \ + b_reg[r_1] = _mm256_permute2f128_pd(t_reg[0], t_reg[1], 0x20); \ + b_reg[r_3] = _mm256_permute2f128_pd(t_reg[0], t_reg[1], 0x31); + +#define TRANSPOSE_8x8() \ + TRANSPOSE_4x4(0, 1, 2, 3) \ + TRANSPOSE_4x4(4, 5, 6, 7) \ + TRANSPOSE_4x4(8, 9, 10, 11) \ + TRANSPOSE_4x4(12, 13, 14, 15) + +static const __m256i mask_reg[6] = {{0, 0, 0, 0}, + {-1, 0, 0, 0}, + {-1, -1, 0, 0}, + {-1, -1, -1, 0}, + {-1, -1, -1, -1}, + {-1, -1, -1, -1}}; + +static void n_8(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + __m256d b_reg[16]; + __m256i mask1, mask2; + __m256d t_reg[3]; + mask1 = mask_reg[4]; + mask2 = mask_reg[4]; + int i, j; + /*****************************************/ + /* B matrix is loaded into the folliwing */ + /* b_reg registers. */ + /*example: col 3, row 4-7 are loaded */ + /* into b_reg[7] */ + /* n-> 0 1 2 3 4 5 6 7 */ + /* -_ _ _ _ _ _ _ _ - */ + /* 0 |0 1 2 3 8 9 10 11| */ + /* 1 |0 1 2 3 8 9 10 11| */ + /* 2 |0 1 2 3 8 9 10 11| */ + /* 3 |0 1 2 3 8 9 10 11| */ + /* 4 |4 5 6 7 12 13 14 15| */ + /* 5 |4 5 6 7 12 13 14 15| */ + /* 6 |4 5 6 7 12 13 14 15| */ + /* 7 |4 5 6 7 12 13 14 15| */ + /* -_ _ _ _ _ _ _ _ - */ + /* */ + /*****************************************/ + for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + b_reg[i + 0 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 0), mask1); + b_reg[i + 4 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 4), mask2); + } + /* To vectorize 'left' variants of TRSM, B matrix is required to be */ + /* stored in row major format, to convert it to row major format, */ + /* B matrix is transposed. */ + + + /*****************************************/ + /* After Transpose the registers are */ + /* changed to following order. */ + /* */ + /* n-> 0 1 2 3 4 5 6 7 */ + /* -_ _ _ _ _ _ _ _ - */ + /* 0 |0 0 0 0 8 8 8 8 | */ + /* 1 |1 1 1 1 9 9 9 9 | */ + /* 2 |2 2 2 2 10 10 10 10| */ + /* 3 |3 3 3 3 11 11 11 11| */ + /* 4 |4 4 4 4 12 12 12 12| */ + /* 5 |5 5 5 5 13 13 13 13| */ + /* 6 |6 6 6 6 14 14 14 14| */ + /* 7 |7 7 7 7 15 15 15 15| */ + /* -_ _ _ _ _ _ _ _ - */ + /* */ + /*****************************************/ + TRANSPOSE_8x8() + + // # REGION - ROW Swap + + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0], t_reg[1] = b_reg[8]; // store row 0(b_reg[0] and b_reg[8]) into temporary registers + b_reg[0] = b_reg[ipiv[0] - 1], b_reg[8] = b_reg[ipiv[0] + 7]; // copy row [ipiv[0]] into row 0 registers + b_reg[ipiv[0] - 1] = t_reg[0], b_reg[ipiv[0] + 7] = t_reg[1]; // copy row 0(from temp registers) to row [ipiv[0]] + + t_reg[0] = b_reg[1], t_reg[1] = b_reg[9]; + b_reg[1] = b_reg[ipiv[1] - 1], b_reg[9] = b_reg[ipiv[1] + 7]; + b_reg[ipiv[1] - 1] = t_reg[0], b_reg[ipiv[1] + 7] = t_reg[1]; + + t_reg[0] = b_reg[2], t_reg[1] = b_reg[10]; + b_reg[2] = b_reg[ipiv[2] - 1], b_reg[10] = b_reg[ipiv[2] + 7]; + b_reg[ipiv[2] - 1] = t_reg[0], b_reg[ipiv[2] + 7] = t_reg[1]; + + t_reg[0] = b_reg[3], t_reg[1] = b_reg[11]; + b_reg[3] = b_reg[ipiv[3] - 1], b_reg[11] = b_reg[ipiv[3] + 7]; + b_reg[ipiv[3] - 1] = t_reg[0], b_reg[ipiv[3] + 7] = t_reg[1]; + + t_reg[0] = b_reg[4], t_reg[1] = b_reg[12]; + b_reg[4] = b_reg[ipiv[4] - 1], b_reg[12] = b_reg[ipiv[4] + 7]; + b_reg[ipiv[4] - 1] = t_reg[0], b_reg[ipiv[4] + 7] = t_reg[1]; + + t_reg[0] = b_reg[5], t_reg[1] = b_reg[13]; + b_reg[5] = b_reg[ipiv[5] - 1], b_reg[13] = b_reg[ipiv[5] + 7]; + b_reg[ipiv[5] - 1] = t_reg[0], b_reg[ipiv[5] + 7] = t_reg[1]; + + t_reg[0] = b_reg[6], t_reg[1] = b_reg[14]; + b_reg[6] = b_reg[ipiv[6] - 1], b_reg[14] = b_reg[ipiv[6] + 7]; + b_reg[ipiv[6] - 1] = t_reg[0], b_reg[ipiv[6] + 7] = t_reg[1]; + + t_reg[0] = b_reg[7], t_reg[1] = b_reg[15]; + b_reg[7] = b_reg[ipiv[7] - 1], b_reg[15] = b_reg[ipiv[7] + 7]; + b_reg[ipiv[7] - 1] = t_reg[0], b_reg[ipiv[7] + 7] = t_reg[1]; + // # ENDREGION - ROW Swap + + // # REGION - TRSM LLNU + + // ROW 0 compute is not needed because diagonal is unit. + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); // t_reg[2] = [ a[1][0], a[1][0], a[1][0], a[1][0] ] + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); // t_reg[0] = b_reg[0] * a[1][0] + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); // t_reg[1] = b_reg[8] * a[1][0] // row0 * a[1][0] + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); // b_reg[1] -= t_teg[0] + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); // b_reg[9] -= t_teg[1] //row1 -= row0 * a[1][0] + // ENDREGION - TRSM row 1 computation + + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); // t_reg[0 to 1] = row0 * a[2][0] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); // t_reg[0 to 1] = row0 * a[2][0] + row1 * a[2][1] + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); // row2 -= row0 * a[2][0] + row1 * a[2][1] + // ENDREGION - TRSM row 2 computation + + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); // t_reg[0 to 1] = row0 * a[3][0] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); // t_reg[0 to 1] = row0 * a[3][0] + row1 * a[3][1] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); // t_reg[0 to 1] = row0 * a[3][0] + row1 * a[3][1] + row2 * a[3][2] + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); // row3 -= row0 * a[3][0] + row1 * a[3][1] + row2 * a[3][2] + // ENDREGION - TRSM row 3 computation + + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); // t_reg[0 to 1] = row0 * a[4][0] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row1 * a[4][1] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row2 * a[4][2] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row3 * a[4][3] + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); //row4 -= t_reg [0 to 1] + // ENDREGION - TRSM row 4 computation + + // REGION - TRSM row 5 computation + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + b_reg[5] = _mm256_sub_pd(b_reg[5], t_reg[0]); + b_reg[13] = _mm256_sub_pd(b_reg[13], t_reg[1]); + // ENDREGION - TRSM row 5 computation + + // REGION - TRSM row 6 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + b_reg[6] = _mm256_sub_pd(b_reg[6], t_reg[0]); + b_reg[14] = _mm256_sub_pd(b_reg[14], t_reg[1]); + // ENDREGION - TRSM row 6 computation + + // REGION - TRSM row 7 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); + b_reg[7] = _mm256_sub_pd(b_reg[7], t_reg[0]); + b_reg[15] = _mm256_sub_pd(b_reg[15], t_reg[1]); + + // ENDREGION - TRSM row 7 computation + + // # ENDREGION - TRSM LLNU + + // # REGION - TRSM LUNN + + // REGION - TRSM row 7 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 7 + (7 * (*lda)))); + b_reg[7] = _mm256_div_pd(b_reg[7], t_reg[2]); + b_reg[15] = _mm256_div_pd(b_reg[15], t_reg[2]); // row7 /= a[7][7] + // ENDREGION - TRSM row 7 computation + + // REGION - TRSM row 6 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); // t_reg[0 to 1] = row7 * a[6][7] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (6 * (*lda)))); + b_reg[6] = _mm256_sub_pd(b_reg[6], t_reg[0]); + b_reg[6] = _mm256_div_pd(b_reg[6], t_reg[2]); + b_reg[14] = _mm256_sub_pd(b_reg[14], t_reg[1]); // row6 -= t_reg[0 to 1] + b_reg[14] = _mm256_div_pd(b_reg[14], t_reg[2]); // row6 /= a[6][6] + // ENDREGION - TRSM row 6 computation + + // REGION - TRSM row 5 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); // t_reg[0 to 1] = row7 * a[5][7] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row6 * a[5][6] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (5 * (*lda)))); + b_reg[5] = _mm256_sub_pd(b_reg[5], t_reg[0]); + b_reg[5] = _mm256_div_pd(b_reg[5], t_reg[2]); + b_reg[13] = _mm256_sub_pd(b_reg[13], t_reg[1]); // row5 -= t_reg[0 to 1] + b_reg[13] = _mm256_div_pd(b_reg[13], t_reg[2]); // row5 /= a[5][5] + // ENDREGION - TRSM row 5 computation + + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); // t_reg[0 to 1] = row7 * a[4][7] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row6 * a[4][6] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); // t_reg[0 to 1] += row5 * a[4][5] + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (4 * (*lda)))); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[4] = _mm256_div_pd(b_reg[4], t_reg[2]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); // row4 -= t_reg[0 to 1] + b_reg[12] = _mm256_div_pd(b_reg[12], t_reg[2]); // row4 /= a[4][4] + // ENDREGION - TRSM row 4 computation + + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (3 * (*lda)))); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[3] = _mm256_div_pd(b_reg[3], t_reg[2]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + b_reg[11] = _mm256_div_pd(b_reg[11], t_reg[2]); + // ENDREGION - TRSM row 3 computation + + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[2]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + b_reg[10] = _mm256_div_pd(b_reg[10], t_reg[2]); + // ENDREGION - TRSM row 2 computation + + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[2]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + b_reg[9] = _mm256_div_pd(b_reg[9], t_reg[2]); + // ENDREGION - TRSM row 1 computation + + // REGION - TRSM row 0 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (7 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[7], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[15], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (6 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[6], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[14], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a)); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[2]); + b_reg[8] = _mm256_sub_pd(b_reg[8], t_reg[1]); + b_reg[8] = _mm256_div_pd(b_reg[8], t_reg[2]); + // ENDREGION - TRSM row 0 computation + // # ENDREGION - TRSM LUNN + + // transpose B matrix again to convert it to column major format + /*****************************************/ + /*Order of registers after transpose */ + /* */ + /* n-> 0 1 2 3 4 5 6 7 */ + /* -_ _ _ _ _ _ _ _ - */ + /* 0 |0 1 2 3 8 9 10 11| */ + /* 1 |0 1 2 3 8 9 10 11| */ + /* 2 |0 1 2 3 8 9 10 11| */ + /* 3 |0 1 2 3 8 9 10 11| */ + /* 4 |4 5 6 7 12 13 14 15| */ + /* 5 |4 5 6 7 12 13 14 15| */ + /* 6 |4 5 6 7 12 13 14 15| */ + /* 7 |4 5 6 7 12 13 14 15| */ + /* -_ _ _ _ _ _ _ _ - */ + /* */ + /*****************************************/ + TRANSPOSE_8x8() + for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + _mm256_maskstore_pd((b + (i * (*ldb)) + 0), mask1, b_reg[i + 0 + j]); + _mm256_maskstore_pd((b + (i * (*ldb)) + 4), mask2, b_reg[i + 4 + j]); + } +} + +static void n_7(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + __m256d b_reg[16]; + __m256i mask1, mask2; + __m256d t_reg[3]; + mask1 = mask_reg[4]; + mask2 = mask_reg[3]; + int i, j; + for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + b_reg[i + 0 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 0), mask1); + b_reg[i + 4 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 4), mask2); + } + TRANSPOSE_8x8() + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0], + t_reg[1] = b_reg[8]; + b_reg[0] = b_reg[ipiv[0] - 1], b_reg[8] = b_reg[ipiv[0] + 7]; + b_reg[ipiv[0] - 1] = t_reg[0], b_reg[ipiv[0] + 7] = t_reg[1]; + + t_reg[0] = b_reg[1], t_reg[1] = b_reg[9]; + b_reg[1] = b_reg[ipiv[1] - 1], b_reg[9] = b_reg[ipiv[1] + 7]; + b_reg[ipiv[1] - 1] = t_reg[0], b_reg[ipiv[1] + 7] = t_reg[1]; + + t_reg[0] = b_reg[2], t_reg[1] = b_reg[10]; + b_reg[2] = b_reg[ipiv[2] - 1], b_reg[10] = b_reg[ipiv[2] + 7]; + b_reg[ipiv[2] - 1] = t_reg[0], b_reg[ipiv[2] + 7] = t_reg[1]; + + t_reg[0] = b_reg[3], t_reg[1] = b_reg[11]; + b_reg[3] = b_reg[ipiv[3] - 1], b_reg[11] = b_reg[ipiv[3] + 7]; + b_reg[ipiv[3] - 1] = t_reg[0], b_reg[ipiv[3] + 7] = t_reg[1]; + + t_reg[0] = b_reg[4], t_reg[1] = b_reg[12]; + b_reg[4] = b_reg[ipiv[4] - 1], b_reg[12] = b_reg[ipiv[4] + 7]; + b_reg[ipiv[4] - 1] = t_reg[0], b_reg[ipiv[4] + 7] = t_reg[1]; + + t_reg[0] = b_reg[5], t_reg[1] = b_reg[13]; + b_reg[5] = b_reg[ipiv[5] - 1], b_reg[13] = b_reg[ipiv[5] + 7]; + b_reg[ipiv[5] - 1] = t_reg[0], b_reg[ipiv[5] + 7] = t_reg[1]; + + t_reg[0] = b_reg[6], t_reg[1] = b_reg[14]; + b_reg[6] = b_reg[ipiv[6] - 1], b_reg[14] = b_reg[ipiv[6] + 7]; + b_reg[ipiv[6] - 1] = t_reg[0], b_reg[ipiv[6] + 7] = t_reg[1]; + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); + // REGION - TRSM row 5 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + b_reg[5] = _mm256_sub_pd(b_reg[5], t_reg[0]); + b_reg[13] = _mm256_sub_pd(b_reg[13], t_reg[1]); + // REGION - TRSM row 6 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + b_reg[6] = _mm256_sub_pd(b_reg[6], t_reg[0]); + b_reg[14] = _mm256_sub_pd(b_reg[14], t_reg[1]); + // REGION - TRSM row 6 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 6 + (6 * (*lda)))); + b_reg[6] = _mm256_div_pd(b_reg[6], t_reg[2]); + b_reg[14] = _mm256_div_pd(b_reg[14], t_reg[2]); + // REGION - TRSM row 5 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (5 * (*lda)))); + b_reg[5] = _mm256_sub_pd(b_reg[5], t_reg[0]); + b_reg[5] = _mm256_div_pd(b_reg[5], t_reg[2]); + b_reg[13] = _mm256_sub_pd(b_reg[13], t_reg[1]); + b_reg[13] = _mm256_div_pd(b_reg[13], t_reg[2]); + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (4 * (*lda)))); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[4] = _mm256_div_pd(b_reg[4], t_reg[2]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); + b_reg[12] = _mm256_div_pd(b_reg[12], t_reg[2]); + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (3 * (*lda)))); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[3] = _mm256_div_pd(b_reg[3], t_reg[2]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + b_reg[11] = _mm256_div_pd(b_reg[11], t_reg[2]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[2]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + b_reg[10] = _mm256_div_pd(b_reg[10], t_reg[2]); + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[2]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + b_reg[9] = _mm256_div_pd(b_reg[9], t_reg[2]); + // REGION - TRSM row 0 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (6 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[6], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[14], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (5 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[5], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[13], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a)); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[2]); + b_reg[8] = _mm256_sub_pd(b_reg[8], t_reg[1]); + b_reg[8] = _mm256_div_pd(b_reg[8], t_reg[2]); + + TRANSPOSE_8x8() for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + _mm256_maskstore_pd((b + (i * (*ldb)) + 0), mask1, b_reg[i + 0 + j]); + _mm256_maskstore_pd((b + (i * (*ldb)) + 4), mask2, b_reg[i + 4 + j]); + } +} + +static void n_6(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + __m256d b_reg[16]; + __m256i mask1, mask2; + __m256d t_reg[3]; + mask1 = mask_reg[4]; + mask2 = mask_reg[2]; + int i, j; + for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + b_reg[i + 0 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 0), mask1); + b_reg[i + 4 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 4), mask2); + } + TRANSPOSE_8x8() + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0], + t_reg[1] = b_reg[8]; + b_reg[0] = b_reg[ipiv[0] - 1], b_reg[8] = b_reg[ipiv[0] + 7]; + b_reg[ipiv[0] - 1] = t_reg[0], b_reg[ipiv[0] + 7] = t_reg[1]; + + t_reg[0] = b_reg[1], t_reg[1] = b_reg[9]; + b_reg[1] = b_reg[ipiv[1] - 1], b_reg[9] = b_reg[ipiv[1] + 7]; + b_reg[ipiv[1] - 1] = t_reg[0], b_reg[ipiv[1] + 7] = t_reg[1]; + + t_reg[0] = b_reg[2], t_reg[1] = b_reg[10]; + b_reg[2] = b_reg[ipiv[2] - 1], b_reg[10] = b_reg[ipiv[2] + 7]; + b_reg[ipiv[2] - 1] = t_reg[0], b_reg[ipiv[2] + 7] = t_reg[1]; + + t_reg[0] = b_reg[3], t_reg[1] = b_reg[11]; + b_reg[3] = b_reg[ipiv[3] - 1], b_reg[11] = b_reg[ipiv[3] + 7]; + b_reg[ipiv[3] - 1] = t_reg[0], b_reg[ipiv[3] + 7] = t_reg[1]; + + t_reg[0] = b_reg[4], t_reg[1] = b_reg[12]; + b_reg[4] = b_reg[ipiv[4] - 1], b_reg[12] = b_reg[ipiv[4] + 7]; + b_reg[ipiv[4] - 1] = t_reg[0], b_reg[ipiv[4] + 7] = t_reg[1]; + + t_reg[0] = b_reg[5], t_reg[1] = b_reg[13]; + b_reg[5] = b_reg[ipiv[5] - 1], b_reg[13] = b_reg[ipiv[5] + 7]; + b_reg[ipiv[5] - 1] = t_reg[0], b_reg[ipiv[5] + 7] = t_reg[1]; + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); + // REGION - TRSM row 5 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + b_reg[5] = _mm256_sub_pd(b_reg[5], t_reg[0]); + b_reg[13] = _mm256_sub_pd(b_reg[13], t_reg[1]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 5 + (5 * (*lda)))); + b_reg[5] = _mm256_div_pd(b_reg[5], t_reg[2]); + b_reg[13] = _mm256_div_pd(b_reg[13], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (5 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[5], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[13], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (4 * (*lda)))); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[4] = _mm256_div_pd(b_reg[4], t_reg[2]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); + b_reg[12] = _mm256_div_pd(b_reg[12], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (5 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[5], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[13], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (3 * (*lda)))); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[3] = _mm256_div_pd(b_reg[3], t_reg[2]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + b_reg[11] = _mm256_div_pd(b_reg[11], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (5 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[5], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[13], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[2]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + b_reg[10] = _mm256_div_pd(b_reg[10], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (5 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[5], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[13], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[2]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + b_reg[9] = _mm256_div_pd(b_reg[9], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (5 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[5], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[13], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (4 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[4], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[12], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a)); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[2]); + b_reg[8] = _mm256_sub_pd(b_reg[8], t_reg[1]); + b_reg[8] = _mm256_div_pd(b_reg[8], t_reg[2]); + + TRANSPOSE_8x8() for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + _mm256_maskstore_pd((b + (i * (*ldb)) + 0), mask1, b_reg[i + 0 + j]); + _mm256_maskstore_pd((b + (i * (*ldb)) + 4), mask2, b_reg[i + 4 + j]); + } +} + +static void n_5(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + __m256d b_reg[16]; + __m256i mask1, mask2; + __m256d t_reg[3]; + mask1 = mask_reg[4]; + mask2 = mask_reg[1]; + int i, j; + for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + b_reg[i + 0 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 0), mask1); + b_reg[i + 4 + j] = _mm256_maskload_pd((void const *)(b + (i * (*ldb)) + 4), mask2); + } + + b_reg[0] = _mm256_maskload_pd((void const *)(b + (0 * (*ldb)) + 0), mask1); + b_reg[4] = _mm256_maskload_pd((void const *)(b + (0 * (*ldb)) + 4), mask2); + b_reg[1] = _mm256_maskload_pd((void const *)(b + (1 * (*ldb)) + 0), mask1); + b_reg[5] = _mm256_maskload_pd((void const *)(b + (1 * (*ldb)) + 4), mask2); + b_reg[2] = _mm256_maskload_pd((void const *)(b + (2 * (*ldb)) + 0), mask1); + b_reg[6] = _mm256_maskload_pd((void const *)(b + (2 * (*ldb)) + 4), mask2); + b_reg[3] = _mm256_maskload_pd((void const *)(b + (3 * (*ldb)) + 0), mask1); + b_reg[7] = _mm256_maskload_pd((void const *)(b + (3 * (*ldb)) + 4), mask2); + b_reg[8] = _mm256_maskload_pd((void const *)(b + (4 * (*ldb)) + 0), mask1); + b_reg[12] = _mm256_maskload_pd((void const *)(b + (4 * (*ldb)) + 4), mask2); + TRANSPOSE_8x8() + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0], + t_reg[1] = b_reg[8]; + b_reg[0] = b_reg[ipiv[0] - 1], b_reg[8] = b_reg[ipiv[0] + 7]; + b_reg[ipiv[0] - 1] = t_reg[0], b_reg[ipiv[0] + 7] = t_reg[1]; + + t_reg[0] = b_reg[1], t_reg[1] = b_reg[9]; + b_reg[1] = b_reg[ipiv[1] - 1], b_reg[9] = b_reg[ipiv[1] + 7]; + b_reg[ipiv[1] - 1] = t_reg[0], b_reg[ipiv[1] + 7] = t_reg[1]; + + t_reg[0] = b_reg[2], t_reg[1] = b_reg[10]; + b_reg[2] = b_reg[ipiv[2] - 1], b_reg[10] = b_reg[ipiv[2] + 7]; + b_reg[ipiv[2] - 1] = t_reg[0], b_reg[ipiv[2] + 7] = t_reg[1]; + + t_reg[0] = b_reg[3], t_reg[1] = b_reg[11]; + b_reg[3] = b_reg[ipiv[3] - 1], b_reg[11] = b_reg[ipiv[3] + 7]; + b_reg[ipiv[3] - 1] = t_reg[0], b_reg[ipiv[3] + 7] = t_reg[1]; + + t_reg[0] = b_reg[4], t_reg[1] = b_reg[12]; + b_reg[4] = b_reg[ipiv[4] - 1], b_reg[12] = b_reg[ipiv[4] + 7]; + b_reg[ipiv[4] - 1] = t_reg[0], b_reg[ipiv[4] + 7] = t_reg[1]; + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + // REGION - TRSM row 4 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[8], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + b_reg[4] = _mm256_sub_pd(b_reg[4], t_reg[0]); + b_reg[12] = _mm256_sub_pd(b_reg[12], t_reg[1]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 4 + (4 * (*lda)))); + b_reg[4] = _mm256_div_pd(b_reg[4], t_reg[2]); + b_reg[12] = _mm256_div_pd(b_reg[12], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (4 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[4], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[12], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (3 * (*lda)))); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + b_reg[3] = _mm256_div_pd(b_reg[3], t_reg[2]); + b_reg[11] = _mm256_sub_pd(b_reg[11], t_reg[1]); + b_reg[11] = _mm256_div_pd(b_reg[11], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (4 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[4], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[12], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[2]); + b_reg[10] = _mm256_sub_pd(b_reg[10], t_reg[1]); + b_reg[10] = _mm256_div_pd(b_reg[10], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (4 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[4], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[12], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[2]); + b_reg[9] = _mm256_sub_pd(b_reg[9], t_reg[1]); + b_reg[9] = _mm256_div_pd(b_reg[9], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (4 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[4], t_reg[2]); + t_reg[1] = _mm256_mul_pd(b_reg[12], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (3 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[3], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[11], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[10], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[1] = _mm256_fmadd_pd(b_reg[9], t_reg[2], t_reg[1]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a)); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[2]); + b_reg[8] = _mm256_sub_pd(b_reg[8], t_reg[1]); + b_reg[8] = _mm256_div_pd(b_reg[8], t_reg[2]); + + TRANSPOSE_8x8() for (i = 0; i < (*nrhs); ++i) + { + j = (int)(i / 4); + j *= 4; + _mm256_maskstore_pd((b + (i * (*ldb)) + 0), mask1, b_reg[i + 0 + j]); + _mm256_maskstore_pd((b + (i * (*ldb)) + 4), mask2, b_reg[i + 4 + j]); + } +} + +static void n_4(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + int i; + __m256d b_reg[4]; + __m256i mask1; + __m256d t_reg[4]; + mask1 = mask_reg[4]; + for (i = 0; i < (*nrhs); ++i) + { + b_reg[i] = _mm256_maskload_pd((void const *)(b + (i * (*ldb))), mask1); + } + TRANSPOSE_4x4(0, 1, 2, 3) + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0]; + b_reg[0] = b_reg[ipiv[0] - 1]; + b_reg[ipiv[0] - 1] = t_reg[0]; + t_reg[1] = b_reg[1]; + b_reg[1] = b_reg[ipiv[1] - 1]; + b_reg[ipiv[1] - 1] = t_reg[1]; + t_reg[2] = b_reg[2]; + b_reg[2] = b_reg[ipiv[2] - 1]; + b_reg[ipiv[2] - 1] = t_reg[2]; + t_reg[3] = b_reg[3]; + b_reg[3] = b_reg[ipiv[3] - 1]; + b_reg[ipiv[3] - 1] = t_reg[3]; + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + // REGION - TRSM row 3 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 3 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + b_reg[3] = _mm256_sub_pd(b_reg[3], t_reg[0]); + + t_reg[3] = _mm256_broadcast_sd((double const *)(a + 3 + (3 * (*lda)))); + b_reg[3] = _mm256_div_pd(b_reg[3], t_reg[3]); + + t_reg[3] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (3 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[3], t_reg[2]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[3]); + + t_reg[3] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (3 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[3], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[3]); + + t_reg[3] = _mm256_broadcast_sd((double const *)(a + 0 + (0 * (*lda)))); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (3 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[3], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (2 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[2], t_reg[2], t_reg[0]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (1 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[3]); + TRANSPOSE_4x4(0, 1, 2, 3) for (i = 0; i < (*nrhs); ++i) + { + _mm256_maskstore_pd((b + (i * (*ldb))), mask1, b_reg[i]); + } +} + +static void n_3(integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *ipiv) +{ + int i; + __m256d b_reg[4]; + __m256i mask1; + __m256d t_reg[4]; + mask1 = mask_reg[3]; + for (i = 0; i < (*nrhs); ++i) + { + b_reg[i] = _mm256_maskload_pd((void const *)(b + (i * (*ldb))), mask1); + } + TRANSPOSE_4x4(0, 1, 2, 3) + /* After tranpose, B matrix is stored in row major format in the b_reg registers*/ + /* so in order to swap row, we only need to swap registers */ + /* Swap Row [n] with Row [Ipiv[n]] */ + t_reg[0] = b_reg[0]; + b_reg[0] = b_reg[ipiv[0] - 1]; + b_reg[ipiv[0] - 1] = t_reg[0]; + t_reg[1] = b_reg[1]; + b_reg[1] = b_reg[ipiv[1] - 1]; + b_reg[ipiv[1] - 1] = t_reg[1]; + t_reg[2] = b_reg[2]; + b_reg[2] = b_reg[ipiv[2] - 1]; + b_reg[ipiv[2] - 1] = t_reg[2]; + // REGION - TRSM row 1 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + // REGION - TRSM row 2 computation + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2)); + t_reg[0] = _mm256_mul_pd(b_reg[0], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (*lda))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + b_reg[2] = _mm256_sub_pd(b_reg[2], t_reg[0]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 2 + (2 * (*lda)))); + b_reg[2] = _mm256_div_pd(b_reg[2], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (2 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[2], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 1 + (1 * (*lda)))); + b_reg[1] = _mm256_sub_pd(b_reg[1], t_reg[0]); + b_reg[1] = _mm256_div_pd(b_reg[1], t_reg[2]); + + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (2 * (*lda)))); + t_reg[0] = _mm256_mul_pd(b_reg[2], t_reg[2]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (1 * (*lda)))); + t_reg[0] = _mm256_fmadd_pd(b_reg[1], t_reg[2], t_reg[0]); + t_reg[2] = _mm256_broadcast_sd((double const *)(a + 0 + (0 * (*lda)))); + b_reg[0] = _mm256_sub_pd(b_reg[0], t_reg[0]); + b_reg[0] = _mm256_div_pd(b_reg[0], t_reg[2]); + TRANSPOSE_4x4(0, 1, 2, 3) for (i = 0; i < (*nrhs); ++i) + { + _mm256_maskstore_pd((b + (i * (*ldb))), mask1, b_reg[i]); + } +} + +/* Small DGETRS path (NOTRANS) should only be used for size between 3 to 8 and NRHS <= N */ +int fla_dgetrs_small_trsm_ll_avx2(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info) +{ + // Array of function pointers + void (*fp[6]) (integer *, integer *, doublereal *, integer *,doublereal *, integer *, integer *) = {n_3, n_4, n_5, n_6, n_7, n_8}; + fp[*n - 3](n, nrhs, a, lda, b, ldb, ipiv); + return 0; +} +#endif diff --git a/src/lapack/x86/avx2/fla_dhrot3_avx2.c b/src/lapack/x86/avx2/fla_dhrot3_avx2.c index 24b199108..d2966419a 100644 --- a/src/lapack/x86/avx2/fla_dhrot3_avx2.c +++ b/src/lapack/x86/avx2/fla_dhrot3_avx2.c @@ -1,5 +1,5 @@ /****************************************************************************** -* Copyright (C) 2022, Advanced Micro Devices, Inc. All rights reserved. +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. *******************************************************************************/ /*! @file fla_dhrot3_avx2.c @@ -7,8 +7,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT /* Application of 3x3 Householder reflector on a 3xn matrix */ int fla_dhrot3_avx2(integer *n, doublereal *a, integer *lda, doublereal *v, doublereal *tau) diff --git a/src/lapack/x86/avx2/fla_drot_avx2.c b/src/lapack/x86/avx2/fla_drot_avx2.c index 5c4dc77fa..64fafd5e6 100644 --- a/src/lapack/x86/avx2/fla_drot_avx2.c +++ b/src/lapack/x86/avx2/fla_drot_avx2.c @@ -1,5 +1,5 @@ /****************************************************************************** -* Copyright (C) 2022, Advanced Micro Devices, Inc. All rights reserved. +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. *******************************************************************************/ /*! @file fla_drot_avx2.c @@ -7,8 +7,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT /* Application of 2x2 Plane Rotation on two vectors */ int fla_drot_avx2(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *c__, doublereal *s) diff --git a/src/lapack/x86/avx2/fla_dscal_ix1_avx2.c b/src/lapack/x86/avx2/fla_dscal_ix1_avx2.c index 0cc0a38d9..662bd27e7 100644 --- a/src/lapack/x86/avx2/fla_dscal_ix1_avx2.c +++ b/src/lapack/x86/avx2/fla_dscal_ix1_avx2.c @@ -7,11 +7,12 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT int fla_dscal_ix1_avx2(integer *n, doublereal *da, doublereal *dx, integer *incx) -{ +{ /* Parameter adjustments */ --dx; /* Function Body */ diff --git a/src/lapack/x86/avx2/fla_lapack_avx2_kernels.h b/src/lapack/x86/avx2/fla_lapack_avx2_kernels.h index 3df68be4f..11946b48b 100644 --- a/src/lapack/x86/avx2/fla_lapack_avx2_kernels.h +++ b/src/lapack/x86/avx2/fla_lapack_avx2_kernels.h @@ -1,5 +1,5 @@ /****************************************************************************** -* Copyright (C) 2022, Advanced Micro Devices, Inc. All rights reserved. +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. *******************************************************************************/ /*! @file fla_lapack_avx2_kernels.h @@ -7,8 +7,13 @@ * */ #include "immintrin.h" +#include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif +#include "fla_dgeqrf_small_avx2.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT int fla_dhrot3_avx2(integer *n, doublereal *a, integer *lda, doublereal *v, doublereal *tau); @@ -21,20 +26,60 @@ int fla_dscal_ix1_avx2(integer *n, doublereal *da, int fla_dgeqrf_small_avx2(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *work); -int fla_dhrot3_avx2(integer *n, doublereal *a, integer *lda, doublereal *v, doublereal *tau); +int fla_dhrot3_avx2(integer *n, + doublereal *a, integer *lda, + doublereal *v, doublereal *tau); int fla_dscal_ix1_avx2(integer *n, doublereal *da, doublereal *dx, integer *incx); -integer fla_lu_piv_small_d_avx2( integer *m, integer *n, doublereal *a, integer *lda, integer *ipiv, integer *info); int fla_sscal_ix1_avx2(integer *n, real *alpha, real *x); -int fla_sger_avx2(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *a, integer *lda); +int fla_sger_avx2(integer *m, integer *n, real *alpha, + real *x, integer *incx, + real *y, integer *incy, + real *a, integer *lda); int fla_zgetrf_small_avx2(integer *m, integer *n, - doublecomplex *a, integer *lda, + dcomplex *a, integer *lda, integer *ipiv, integer *info); int fla_zrot_avx2(integer *n, - doublecomplex *cx, integer *incx, - doublecomplex *cy, integer *incy, - doublereal *c__, doublecomplex *s); -int fla_zscal_avx2(integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx); + doublecomplex *cx, integer *incx, + doublecomplex *cy, integer *incy, + doublereal *c__, doublecomplex *s); +int fla_zscal_avx2(integer *n, doublecomplex *alpha, + doublecomplex *x, integer *incx); int fla_zscal_ix1_avx2(integer *n, doublecomplex *alpha, doublecomplex *x); +integer fla_dgetrf_small_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + integer *ipiv, + integer *info); +void fla_lu_piv_small_d_update_tr_matrix_avx2(integer i_1, integer mi, integer ni, + doublereal* acur, integer lda_t); +void fla_dgesvd_small6T_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *ql, integer *ldql, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info); +void fla_dgesvd_small6_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *ql, integer *ldql, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info); +void fla_dgesvd_nn_small10_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info); +void fla_dgesvd_nn_small1T_avx2(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info); +integer fla_dgetrf_small_avx2( integer *m, integer *n, doublereal *a, integer *lda, integer *ipiv, integer *info); +void fla_lu_piv_small_d_update_tr_matrix_avx2(integer i_1, integer mi, integer ni, doublereal* acur, integer lda_t); +int fla_dgetrs_small_trsm_ll_avx2(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info); #endif diff --git a/src/lapack/x86/avx2/fla_lu_piv_small_d_update_tr_matrix_avx2.c b/src/lapack/x86/avx2/fla_lu_piv_small_d_update_tr_matrix_avx2.c new file mode 100644 index 000000000..54d04ec9e --- /dev/null +++ b/src/lapack/x86/avx2/fla_lu_piv_small_d_update_tr_matrix_avx2.c @@ -0,0 +1,74 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +/* + * LU with partial pivoting for tiny matrices + * + * All the computations are done inline without using + * corresponding BLAS APIs to reduce function overheads. + */ +void fla_lu_piv_small_d_update_tr_matrix_avx2(integer i_1, integer mi, integer ni, doublereal *acur, integer lda_t) + { + + integer j, b_off, y_off; + doublereal p_val; + __m256d result[4], tempY[4], tempb[4], tempx, p_val4; + + p_val = *acur; + p_val = 1 / p_val; + p_val4 = _mm256_broadcast_sd(&p_val); + for( ; i_1 < mi-3; i_1+=4 ) + { + tempx = _mm256_mul_pd(_mm256_loadu_pd(&acur[i_1]), p_val4); + _mm256_storeu_pd(&acur[i_1], tempx); + + for( j = 1; j < ni-3; j+=4 ) + { + b_off = j * lda_t; + y_off = i_1 + j * lda_t; + tempb[0] = _mm256_broadcast_sd(&acur[b_off]); + tempb[1] = _mm256_broadcast_sd(&acur[b_off] + 1*lda_t); + tempb[2] = _mm256_broadcast_sd(&acur[b_off] + 2*lda_t); + tempb[3] = _mm256_broadcast_sd(&acur[b_off] + 3*lda_t); + tempY[0] = _mm256_loadu_pd(&acur[y_off]); + tempY[1] = _mm256_loadu_pd(&acur[y_off] + 1*lda_t); + tempY[2] = _mm256_loadu_pd(&acur[y_off] + 2*lda_t); + tempY[3] = _mm256_loadu_pd(&acur[y_off] + 3*lda_t); + //Y := Y - b * x + result[0] = _mm256_fnmadd_pd(tempb[0], tempx, tempY[0]); + result[1] = _mm256_fnmadd_pd(tempb[1], tempx, tempY[1]); + result[2] = _mm256_fnmadd_pd(tempb[2], tempx, tempY[2]); + result[3] = _mm256_fnmadd_pd(tempb[3], tempx, tempY[3]); + _mm256_storeu_pd(&acur[y_off], result[0]); + _mm256_storeu_pd(( &acur[y_off] + 1 * lda_t), result[1]); + _mm256_storeu_pd(( &acur[y_off] + 2 * lda_t), result[2]); + _mm256_storeu_pd(( &acur[y_off] + 3 * lda_t), result[3]); + } + /* remining inner loop updation */ + for (; j < ni; j++) + { + b_off = j * lda_t; + y_off = i_1 + j * lda_t; + tempb[0] = _mm256_broadcast_sd(&acur[b_off]); + tempY[0] = _mm256_loadu_pd(&acur[y_off]); + result[0] = _mm256_fnmadd_pd(tempb[0], tempx, tempY[0]); + _mm256_storeu_pd(&acur[y_off], result[0]); + } + } + /* remining outer loop updation */ + for (; i_1 < mi; i_1++) + { + acur[i_1] = acur[i_1] * p_val; + for (j = 1; j < ni; j++) + { + acur[i_1 + j * lda_t] = acur[i_1 + j * lda_t] - acur[j * lda_t] * acur[i_1]; + } + } + } +#endif diff --git a/src/lapack/x86/avx2/fla_sger_avx2.c b/src/lapack/x86/avx2/fla_sger_avx2.c index 1ed7a933e..e79e3d8cb 100644 --- a/src/lapack/x86/avx2/fla_sger_avx2.c +++ b/src/lapack/x86/avx2/fla_sger_avx2.c @@ -7,8 +7,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT int fla_sger_avx2(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *a, integer *lda) { /* Local Variables */ @@ -211,4 +212,4 @@ int fla_sger_avx2(integer *m, integer *n, real *alpha, real *x, integer *incx, r } return 0; } -#endif \ No newline at end of file +#endif diff --git a/src/lapack/x86/avx2/fla_sscal_ix1_avx2.c b/src/lapack/x86/avx2/fla_sscal_ix1_avx2.c index 7152d5159..743ea5ad5 100644 --- a/src/lapack/x86/avx2/fla_sscal_ix1_avx2.c +++ b/src/lapack/x86/avx2/fla_sscal_ix1_avx2.c @@ -7,8 +7,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT int fla_sscal_ix1_avx2(integer *n, real *alpha, real *x) { /* Local variables */ @@ -132,4 +133,4 @@ int fla_sscal_ix1_avx2(integer *n, real *alpha, real *x) } return 0; } -#endif \ No newline at end of file +#endif diff --git a/src/lapack/x86/avx2/fla_zgetrf_avx2.c b/src/lapack/x86/avx2/fla_zgetrf_avx2.c index fa23eb19e..5d58fde8d 100644 --- a/src/lapack/x86/avx2/fla_zgetrf_avx2.c +++ b/src/lapack/x86/avx2/fla_zgetrf_avx2.c @@ -3,30 +3,30 @@ *******************************************************************************/ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT /* * LU with partial pivoting for tiny matrices * * All the computations are done inline without using * corresponding BLAS APIs to reduce function overheads. */ -int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *lda, integer *ipiv, integer *info) +int fla_zgetrf_small_avx2( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) { integer mi, ni; integer i, j, i_1, i_2, i_3, i_4, i_5, i_6, i_7; - doublereal max_val, t_val, z_val; - doublecomplex *acur, *apiv, *asrc; - doublecomplex z__1; + double max_val, t_val, z_val; + dcomplex *acur, *apiv, *asrc; + dcomplex z__1; integer p_idx; integer min_m_n = fla_min(*m, *n); - __m256d alpha; - __m256d bv[2], bv_p[2], temp[8], xv0[2], xv1[2], yv0[2], yv1[2]; - __m256d neg = _mm256_setr_pd(1.0, -1.0, 1.0, -1.0); + __m256d alpha_real, alpha_img, x_real[2], x_img[2]; + __m256d bv[2], bv_p[2], xv0[2], xv1[2], yv0[2], yv1[2]; #ifndef _WIN32 double _Complex pinv; #else - doublecomplex y__1 = {1, 0}; + dcomplex y__1 = {1, 0}; #endif *info = 0; @@ -61,7 +61,7 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld p_idx = i; for( i_1 = 0; i_1 < mi; i_1++ ) { - t_val = f2c_abs(acur[i_1].r) + f2c_abs(acur[i_1].i); + t_val = f2c_abs(acur[i_1].real) + f2c_abs(acur[i_1].imag); if( t_val > max_val ) { max_val = t_val; @@ -74,19 +74,19 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld ipiv[i] = p_idx + 1; // Swap rows - if( apiv[*lda * i].r != 0. || apiv[*lda * i].i != 0. ) + if( apiv[*lda * i].real != 0. || apiv[*lda * i].imag != 0. ) { if( p_idx != i ) { for( i_1 = 0; i_1 < *n ; i_1++ ) { i_2 = i_1 * *lda; - t_val = apiv[i_2].r; - z_val = apiv[i_2].i; - apiv[i_2].r = asrc[i_2].r; - apiv[i_2].i = asrc[i_2].i; - asrc[i_2].r = t_val; - asrc[i_2].i = z_val; + t_val = apiv[i_2].real; + z_val = apiv[i_2].imag; + apiv[i_2].real = asrc[i_2].real; + apiv[i_2].imag = asrc[i_2].imag; + asrc[i_2].real = t_val; + asrc[i_2].imag = z_val; } } @@ -104,15 +104,16 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld // Calculate scalefactors (a21) & update trailing matrix #ifndef _WIN32 - pinv = 1.0 / ((*acur).r + I * (*acur).i); - z__1.r = creal(pinv); - z__1.i = cimag(pinv); + pinv = 1.0 / ((*acur).real + I * (*acur).imag); + z__1.real = creal(pinv); + z__1.imag = cimag(pinv); #else - dladiv_(&y__1.r, &y__1.i, &acur->r, &acur->i, &z__1.r, &z__1.i); + dladiv_(&y__1.real, &y__1.imag, &acur->real, &acur->imag, &z__1.real, &z__1.imag); #endif // Load alpha from memory - alpha = _mm256_set_pd(z__1.i, z__1.r, z__1.i, z__1.r); + alpha_real = _mm256_set1_pd(z__1.real); + alpha_img = _mm256_set1_pd(z__1.imag); // Updates 4 rows of trailing matrix per iteration for(i_1 = 1; i_1 < mi - 3; i_1+=4 ) @@ -130,51 +131,44 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld SIMD algorithm: - alpha = aR1 aI1 aR1 aI1 + alpha_real = aR1 aR1 aR1 aR1 + alpha_img = aI1 aI1 aI1 aI1 bv = bR1 bI1 bR2 bI2 bv_p = bI1 bR1 bI2 bR2 - xv = xR1 xI1 xR1 xI1 + x_real = xR1 xR1 xR1 xR1 + x_img = xI1 xI1 xI1 xI1 yv = yR1 yI1 yR2 yI2 step 1 => b := alpha * b - bv = alpha * bv - bv_p = alpha * (-bv_p) - bv = bv - bv_p - bv_p = shuffle(bv) + bv_p = alpha_img * bv_p + bv = ( alpha_real * bv ) - bv_p step 2 => Y := Y - b * x - temp = xv * bv - temp1 = xv * (-bv_p) - xv = temp0 - temp1 + xv = x_img * bv_p + xv = ( x_real * bv ) - xv yv = yv - xv ------------------------------------------------------------------*/ i_2 = i_1 + 2; // Load alpha from memory - bv[0] = _mm256_loadu_pd((double const *) &acur[i_1].r); - bv[1] = _mm256_loadu_pd((double const *) &acur[i_2].r); + bv[0] = _mm256_loadu_pd((double const *) &acur[i_1].real); + bv[1] = _mm256_loadu_pd((double const *) &acur[i_2].real); bv_p[0] = _mm256_permute_pd(bv[0], 0x5); bv_p[1] = _mm256_permute_pd(bv[1], 0x5); // b := alpha * b - bv[0] = _mm256_mul_pd(alpha, bv[0]); - bv_p[0] = _mm256_mul_pd(bv_p[0], neg); - bv_p[0] = _mm256_mul_pd(alpha, bv_p[0]); - bv[1] = _mm256_mul_pd(alpha, bv[1]); - bv_p[1] = _mm256_mul_pd(bv_p[1], neg); - bv_p[1] = _mm256_mul_pd(alpha, bv_p[1]); + bv_p[0] = _mm256_mul_pd(alpha_img, bv_p[0]); + bv_p[1] = _mm256_mul_pd(alpha_img, bv_p[1]); - bv[0] = _mm256_hsub_pd(bv[0], bv_p[0]); - bv[1] = _mm256_hsub_pd(bv[1], bv_p[1]); + bv[0] = _mm256_fmaddsub_pd(alpha_real, bv[0], bv_p[0]); + bv[1] = _mm256_fmaddsub_pd(alpha_real, bv[1], bv_p[1]); - _mm256_storeu_pd ((double *) &acur[i_1].r, bv[0]); - _mm256_storeu_pd ((double *) &acur[i_2].r, bv[1]); + _mm256_storeu_pd ((double *) &acur[i_1].real, bv[0]); + _mm256_storeu_pd ((double *) &acur[i_2].real, bv[1]); bv_p[0] = _mm256_permute_pd(bv[0], 0x5); bv_p[1] = _mm256_permute_pd(bv[1], 0x5); - bv_p[0] = _mm256_mul_pd(bv_p[0], neg); - bv_p[1] = _mm256_mul_pd(bv_p[1], neg); for( j = 1; j < ni - 1; j = j + 2 ) { @@ -188,38 +182,36 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld i_7 = i_5 + 2; // Load x from memory - xv0[0] = _mm256_set_pd(acur[i_3].i, acur[i_3].r, acur[i_3].i, acur[i_3].r); - xv1[0] = _mm256_set_pd(acur[i_4].i, acur[i_4].r, acur[i_4].i, acur[i_4].r); + x_real[0] = _mm256_set1_pd(acur[i_3].real); + x_img[0] = _mm256_set1_pd(acur[i_3].imag); + x_real[1] = _mm256_set1_pd(acur[i_4].real); + x_img[1] = _mm256_set1_pd(acur[i_4].imag); // Y := Y - b * x - temp[0] = _mm256_mul_pd(xv0[0], bv[0]); - temp[1] = _mm256_mul_pd(xv0[0], bv_p[0]); - temp[2] = _mm256_mul_pd(xv0[0], bv[1]); - temp[3] = _mm256_mul_pd(xv0[0], bv_p[1]); - temp[4] = _mm256_mul_pd(xv1[0], bv[0]); - temp[5] = _mm256_mul_pd(xv1[0], bv_p[0]); - temp[6] = _mm256_mul_pd(xv1[0], bv[1]); - temp[7] = _mm256_mul_pd(xv1[0], bv_p[1]); - - xv0[0] = _mm256_hsub_pd(temp[0], temp[1]); - xv0[1] = _mm256_hsub_pd(temp[2], temp[3]); - xv1[0] = _mm256_hsub_pd(temp[4], temp[5]); - xv1[1] = _mm256_hsub_pd(temp[6], temp[7]); - - yv0[0] = _mm256_loadu_pd((double const *) &acur[i_2].r); - yv0[1] = _mm256_loadu_pd((double const *) &acur[i_6].r); - yv1[0] = _mm256_loadu_pd((double const *) &acur[i_5].r); - yv1[1] = _mm256_loadu_pd((double const *) &acur[i_7].r); + xv0[0] = _mm256_mul_pd(x_img[0], bv_p[0]); + xv0[1] = _mm256_mul_pd(x_img[0], bv_p[1]); + xv1[0] = _mm256_mul_pd(x_img[1], bv_p[0]); + xv1[1] = _mm256_mul_pd(x_img[1], bv_p[1]); + + xv0[0] = _mm256_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + xv0[1] = _mm256_fmaddsub_pd(x_real[0], bv[1], xv0[1]); + xv1[0] = _mm256_fmaddsub_pd(x_real[1], bv[0], xv1[0]); + xv1[1] = _mm256_fmaddsub_pd(x_real[1], bv[1], xv1[1]); + + yv0[0] = _mm256_loadu_pd((double const *) &acur[i_2].real); + yv0[1] = _mm256_loadu_pd((double const *) &acur[i_6].real); + yv1[0] = _mm256_loadu_pd((double const *) &acur[i_5].real); + yv1[1] = _mm256_loadu_pd((double const *) &acur[i_7].real); yv0[0] = _mm256_sub_pd(yv0[0], xv0[0]); yv0[1] = _mm256_sub_pd(yv0[1], xv0[1]); yv1[0] = _mm256_sub_pd(yv1[0], xv1[0]); yv1[1] = _mm256_sub_pd(yv1[1], xv1[1]); - _mm256_storeu_pd ((double *) &acur[i_2].r, yv0[0]); - _mm256_storeu_pd ((double *) &acur[i_6].r, yv0[1]); - _mm256_storeu_pd ((double *) &acur[i_5].r, yv1[0]); - _mm256_storeu_pd ((double *) &acur[i_7].r, yv1[1]); + _mm256_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + _mm256_storeu_pd ((double *) &acur[i_6].real, yv0[1]); + _mm256_storeu_pd ((double *) &acur[i_5].real, yv1[0]); + _mm256_storeu_pd ((double *) &acur[i_7].real, yv1[1]); } if(ni - j > 0) { @@ -229,45 +221,44 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld i_4 = i_2 + 2; // Load x from memory - xv0[0] = _mm256_set_pd(acur[i_3].i, acur[i_3].r, acur[i_3].i, acur[i_3].r); + x_real[0] = _mm256_set1_pd(acur[i_3].real); + x_img[0] = _mm256_set1_pd(acur[i_3].imag); // Y := Y - b * x - temp[0] = _mm256_mul_pd(xv0[0], bv[0]); - temp[1] = _mm256_mul_pd(xv0[0], bv_p[0]); - temp[2] = _mm256_mul_pd(xv0[0], bv[1]); - temp[3] = _mm256_mul_pd(xv0[0], bv_p[1]); + xv0[0] = _mm256_mul_pd(x_img[0], bv_p[0]); + xv0[1] = _mm256_mul_pd(x_img[0], bv_p[1]); - xv0[0] = _mm256_hsub_pd(temp[0], temp[1]); - xv0[1] = _mm256_hsub_pd(temp[2], temp[3]); + xv0[0] = _mm256_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + xv0[1] = _mm256_fmaddsub_pd(x_real[0], bv[1], xv0[1]); - yv0[0] = _mm256_loadu_pd((double const *) &acur[i_2].r); - yv0[1] = _mm256_loadu_pd((double const *) &acur[i_4].r); + yv0[0] = _mm256_loadu_pd((double const *) &acur[i_2].real); + yv0[1] = _mm256_loadu_pd((double const *) &acur[i_4].real); yv0[0] = _mm256_sub_pd(yv0[0], xv0[0]); yv0[1] = _mm256_sub_pd(yv0[1], xv0[1]); - _mm256_storeu_pd ((double *) &acur[i_2].r, yv0[0]); - _mm256_storeu_pd ((double *) &acur[i_4].r, yv0[1]); + _mm256_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + _mm256_storeu_pd ((double *) &acur[i_4].real, yv0[1]); } } // Updates 1 row of trailing matrix per iteration for( ; i_1 < mi; i_1++ ) { - t_val = acur[i_1].r; - acur[i_1].r = (t_val * z__1.r - acur[i_1].i * z__1.i); - acur[i_1].i = (t_val * z__1.i + acur[i_1].i * z__1.r); + t_val = acur[i_1].real; + acur[i_1].real = (t_val * z__1.real - acur[i_1].imag * z__1.imag); + acur[i_1].imag = (t_val * z__1.imag + acur[i_1].imag * z__1.real); - t_val = acur[i_1].r; - z_val = acur[i_1].i; + t_val = acur[i_1].real; + z_val = acur[i_1].imag; for( j = 1; j < ni; j++ ) { i_3 = j * *lda; i_2 = i_1 + i_3; - acur[i_2].r = acur[i_2].r - t_val * acur[i_3].r + z_val * acur[i_3].i; - acur[i_2].i = acur[i_2].i - t_val * acur[i_3].i - z_val * acur[i_3].r; + acur[i_2].real = acur[i_2].real - t_val * acur[i_3].real + z_val * acur[i_3].imag; + acur[i_2].imag = acur[i_2].imag - t_val * acur[i_3].imag - z_val * acur[i_3].real; } } } @@ -279,4 +270,4 @@ int fla_zgetrf_small_avx2( integer *m, integer *n, doublecomplex *a, integer *ld return *info; } -#endif \ No newline at end of file +#endif diff --git a/src/lapack/x86/avx2/fla_zrot_avx2.c b/src/lapack/x86/avx2/fla_zrot_avx2.c index 70a8fe9c6..44f1fffb1 100644 --- a/src/lapack/x86/avx2/fla_zrot_avx2.c +++ b/src/lapack/x86/avx2/fla_zrot_avx2.c @@ -7,8 +7,9 @@ * * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT /* Application of 2x2 Plane Rotation on two vectors */ int fla_zrot_avx2(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s) diff --git a/src/lapack/x86/avx2/fla_zscal_ix1_avx2.c b/src/lapack/x86/avx2/fla_zscal_ix1_avx2.c index 28d590e63..032e6f633 100644 --- a/src/lapack/x86/avx2/fla_zscal_ix1_avx2.c +++ b/src/lapack/x86/avx2/fla_zscal_ix1_avx2.c @@ -8,8 +8,9 @@ * */ #include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT int fla_zscal_ix1_avx2(integer *n, doublecomplex *alpha, doublecomplex *x) { /* Local variables */ diff --git a/src/lapack/x86/avx512/CMakeLists.txt b/src/lapack/x86/avx512/CMakeLists.txt new file mode 100644 index 000000000..66339fba2 --- /dev/null +++ b/src/lapack/x86/avx512/CMakeLists.txt @@ -0,0 +1,14 @@ +##Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved.## + +add_library(AVX512_LU + OBJECT + ${CMAKE_CURRENT_SOURCE_DIR}/fla_lapack_avx512_kernels.h + ${CMAKE_CURRENT_SOURCE_DIR}/fla_dgetrf_small_avx512.c + ${CMAKE_CURRENT_SOURCE_DIR}/fla_zgetrf_small_avx512.c +) + +if(WIN32) +target_compile_options(AVX512_LU PRIVATE /arch:AVX512) +else(UNIX) +target_compile_options(AVX512_LU PRIVATE -mavx512f -mfma) +endif() diff --git a/src/lapack/x86/avx512/fla_dgetrf_small_avx512.c b/src/lapack/x86/avx512/fla_dgetrf_small_avx512.c new file mode 100644 index 000000000..7f719daf5 --- /dev/null +++ b/src/lapack/x86/avx512/fla_dgetrf_small_avx512.c @@ -0,0 +1,138 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT + +/* + * LU with partial pivoting for tiny matrices + * + * All the computations are done inline without using + * corresponding BLAS APIs to reduce function overheads. + */ +integer fla_dgetrf_small_avx512( integer *m, integer *n, + doublereal *a, integer *lda, + integer *ipiv, + integer *info) +{ + integer mi, ni; + integer i, j, i_1, lda_t, b_off, y_off; + + doublereal p_val, max_val, t_val; + doublereal *acur, *apiv, *asrc; + integer p_idx; + __m512d result[8], tempY[8], tempb[8], tempx, p_val4; + integer min_m_n = fla_min(*m, *n); + lda_t = *lda; + + for( i = 0; i < min_m_n; i++ ) + { + mi = *m - i; + ni = *n - i; + + acur = &a[i + lda_t * i]; + + /* Find the pivot element */ + max_val = 0; + p_idx = i; + for( i_1 = 0; i_1 < mi; i_1++ ) + { + t_val = acur[i_1]; + t_val = ( t_val < 0.0 ) ? -t_val : t_val; + if( t_val > max_val ) + { + max_val = t_val; + p_idx = i + i_1; + } + } + + apiv = a + p_idx; + asrc = a + i; + ipiv[i] = p_idx + 1; + + /* Swap rows and calculate a column of L */ + if( max_val != 0.0 ) + { + /* Swap entire rows */ + if( p_idx != i) + { + for( i_1 = 0; i_1 < *n; i_1++ ) + { + t_val = apiv[i_1 * lda_t]; + apiv[i_1 * *lda] = asrc[i_1 * lda_t]; + asrc[i_1 * *lda] = t_val; + } + } + + /* Calculate scalefactors (L) & update trailing matrix */ + p_val = *acur; + p_val = 1 / p_val; + p_val4 = _mm512_set1_pd(p_val); + for( i_1 = 1; i_1 < mi-7; i_1+=8 ) + { + tempx = _mm512_mul_pd(_mm512_loadu_pd(&acur[i_1]), p_val4); + _mm512_storeu_pd(&acur[i_1], tempx); + + for( j = 1; j < ni-7; j+=8 ) + { + b_off = j * lda_t; + y_off = i_1 + j * lda_t; + tempb[0] = _mm512_set1_pd(acur[b_off]); + tempb[1] = _mm512_set1_pd(acur[b_off + 1*lda_t]); + tempb[2] = _mm512_set1_pd(acur[b_off + 2*lda_t]); + tempb[3] = _mm512_set1_pd(acur[b_off + 3*lda_t]); + tempb[4] = _mm512_set1_pd(acur[b_off + 4*lda_t]); + tempb[5] = _mm512_set1_pd(acur[b_off + 5*lda_t]); + tempb[6] = _mm512_set1_pd(acur[b_off + 6*lda_t]); + tempb[7] = _mm512_set1_pd(acur[b_off + 7*lda_t]); + tempY[0] = _mm512_loadu_pd(&acur[y_off]); + tempY[1] = _mm512_loadu_pd(&acur[y_off + 1*lda_t]); + tempY[2] = _mm512_loadu_pd(&acur[y_off + 2*lda_t]); + tempY[3] = _mm512_loadu_pd(&acur[y_off + 3*lda_t]); + tempY[4] = _mm512_loadu_pd(&acur[y_off + 4*lda_t]); + tempY[5] = _mm512_loadu_pd(&acur[y_off + 5*lda_t]); + tempY[6] = _mm512_loadu_pd(&acur[y_off + 6*lda_t]); + tempY[7] = _mm512_loadu_pd(&acur[y_off + 7*lda_t]); + /* Y := Y - b * x */ + result[0] = _mm512_fnmadd_pd(tempb[0], tempx, tempY[0]); + result[1] = _mm512_fnmadd_pd(tempb[1], tempx, tempY[1]); + result[2] = _mm512_fnmadd_pd(tempb[2], tempx, tempY[2]); + result[3] = _mm512_fnmadd_pd(tempb[3], tempx, tempY[3]); + result[4] = _mm512_fnmadd_pd(tempb[4], tempx, tempY[4]); + result[5] = _mm512_fnmadd_pd(tempb[5], tempx, tempY[5]); + result[6] = _mm512_fnmadd_pd(tempb[6], tempx, tempY[6]); + result[7] = _mm512_fnmadd_pd(tempb[7], tempx, tempY[7]); + _mm512_storeu_pd(&acur[y_off], result[0]); + _mm512_storeu_pd(&acur[y_off + 1 * lda_t], result[1]); + _mm512_storeu_pd(&acur[y_off + 2 * lda_t], result[2]); + _mm512_storeu_pd(&acur[y_off + 3 * lda_t], result[3]); + _mm512_storeu_pd(&acur[y_off + 4 * lda_t], result[4]); + _mm512_storeu_pd(&acur[y_off + 5 * lda_t], result[5]); + _mm512_storeu_pd(&acur[y_off + 6 * lda_t], result[6]); + _mm512_storeu_pd(&acur[y_off + 7 * lda_t], result[7]); + } + /* remining inner loop updation*/ + for (; j < ni; j++) + { + b_off = j * lda_t; + y_off = i_1 + j * lda_t; + tempb[0] = _mm512_set1_pd(acur[b_off]); + tempY[0] = _mm512_loadu_pd(&acur[y_off]); + result[0] = _mm512_fnmadd_pd(tempb[0], tempx, tempY[0]); + _mm512_storeu_pd(&acur[y_off], result[0]); + } + } + /* remining outer loop last 7 iteration updat with avx2 */ + fla_lu_piv_small_d_update_tr_matrix_avx2(i_1, mi, ni, acur, *lda); + } + else + { + *info = ( *info == 0 ) ? p_idx + 1 : *info; + } + } + return *info; +} +#endif diff --git a/src/lapack/x86/avx512/fla_lapack_avx512_kernels.h b/src/lapack/x86/avx512/fla_lapack_avx512_kernels.h new file mode 100644 index 000000000..7369ac6cc --- /dev/null +++ b/src/lapack/x86/avx512/fla_lapack_avx512_kernels.h @@ -0,0 +1,15 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file fla_lapack_avx512_kernels.h + * @brief AVX512 Kernel Declarations. + * */ + +#include "immintrin.h" + +#if FLA_ENABLE_AMD_OPT +int fla_zgetrf_small_avx512(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info); +integer fla_dgetrf_small_avx512( integer *m, integer *n, doublereal *a, integer *lda, integer *ipiv, integer *info); +#endif + diff --git a/src/lapack/x86/avx512/fla_zgetrf_small_avx512.c b/src/lapack/x86/avx512/fla_zgetrf_small_avx512.c new file mode 100644 index 000000000..026f13d90 --- /dev/null +++ b/src/lapack/x86/avx512/fla_zgetrf_small_avx512.c @@ -0,0 +1,392 @@ +/****************************************************************************** +* Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +#include "FLAME.h" +#include "fla_lapack_avx2_kernels.h" + +#if FLA_ENABLE_AMD_OPT +/* + * LU with partial pivoting for tiny matrices + * + * All the computations are done inline without using + * corresponding BLAS APIs to reduce function overheads. + */ +int fla_zgetrf_small_avx512( integer *m, integer *n, dcomplex *a, integer *lda, integer *ipiv, integer *info) +{ + integer mi, ni; + integer i, j, i_1, i_2, i_3, i_4, i_5, i_6, i_7; + doublereal max_val, t_val, z_val; + dcomplex *acur, *apiv, *asrc; + dcomplex z__1; + integer p_idx; + integer min_m_n = fla_min(*m, *n); + __m512d alpha_real, alpha_img, x_real[2], x_img[2]; + __m512d bv[2], bv_p[2], xv0[2], xv1[2], yv0[2], yv1[2]; + +#ifndef _WIN32 + double _Complex pinv; +#else + dcomplex y__1 = {1, 0}; +#endif + + *info = 0; + + if (*m < 0) + { + *info = -1; + } + else if (*n < 0) + { + *info = -2; + } + else if (*lda < fla_max(1,*m)) + { + *info = -4; + } + + if (*info != 0) + { + return 0; + } + + for( i = 0; i < min_m_n; i++ ) + { + mi = *m - i; + ni = *n - i; + + acur = &a[i + *lda * i]; + + // Find the pivot element + max_val = 0; + p_idx = i; + for( i_1 = 0; i_1 < mi; i_1++ ) + { + t_val = f2c_abs(acur[i_1].real) + f2c_abs(acur[i_1].imag); + if( t_val > max_val ) + { + max_val = t_val; + p_idx = i + i_1; + } + } + + apiv = a + p_idx; + asrc = a + i; + ipiv[i] = p_idx + 1; + + // Swap rows + if( apiv[*lda * i].real != 0. || apiv[*lda * i].imag != 0. ) + { + if( p_idx != i ) + { + for( i_1 = 0; i_1 < *n ; i_1++ ) + { + i_2 = i_1 * *lda; + t_val = apiv[i_2].real; + z_val = apiv[i_2].imag; + apiv[i_2].real = asrc[i_2].real; + apiv[i_2].imag = asrc[i_2].imag; + asrc[i_2].real = t_val; + asrc[i_2].imag = z_val; + } + } + + /*----------------unblocked LU algorithm------------------------- + + A00 | a01 A02 + ----|----------- + a10 | a11 a12 + A20 | a21 A22 + + alpha = 1 / a11 + a21 := a21 * alpha + A22 := A22 - a21 * a12 + ------------------------------------------------------------------*/ + + // Calculate scalefactors (a21) & update trailing matrix +#ifndef _WIN32 + pinv = 1.0 / ((*acur).real + I * (*acur).imag); + z__1.real = creal(pinv); + z__1.imag = cimag(pinv); +#else + dladiv_(&y__1.real, &y__1.imag, &acur->real, &acur->imag, &z__1.real, &z__1.imag); +#endif + + // Load alpha from memory + alpha_real = _mm512_set1_pd(z__1.real); + alpha_img = _mm512_set1_pd(z__1.imag); + + // Updates 8 rows of trailing matrix per iteration + for(i_1 = 1; i_1 < mi - 7; i_1+=8 ) + { + /*-----------Trailing matrix update for LU factorisation----------- + + A00 | a01 A02 + ----|----------- + a10 | alpha x + A20 | b Y + + b := alpha * b + Y := Y - b * x + + + SIMD algorithm: + + alpha_real = aR1 aR1 aR1 aR1 + alpha_img = aI1 aI1 aI1 aI1 + bv = bR1 bI1 bR2 bI2 + bv_p = bI1 bR1 bI2 bR2 + x_real = xR1 xR1 xR1 xR1 + x_img = xI1 xI1 xI1 xI1 + yv = yR1 yI1 yR2 yI2 + + step 1 => b := alpha * b + bv_p = alpha_img * bv_p + bv = ( alpha_real * bv ) - bv_p + + step 2 => Y := Y - b * x + xv = x_img * bv_p + xv = ( x_real * bv ) - xv + yv = yv - xv + ------------------------------------------------------------------*/ + + i_2 = i_1 + 4; + + // Load alpha from memory + bv[0] = _mm512_loadu_pd((double const *) &acur[i_1].real); + bv[1] = _mm512_loadu_pd((double const *) &acur[i_2].real); + bv_p[0] = _mm512_permute_pd(bv[0], 0x55); + bv_p[1] = _mm512_permute_pd(bv[1], 0x55); + + // b := alpha * b + bv_p[0] = _mm512_mul_pd(alpha_img, bv_p[0]); + bv_p[1] = _mm512_mul_pd(alpha_img, bv_p[1]); + bv[0] = _mm512_fmaddsub_pd(alpha_real, bv[0], bv_p[0]); + bv[1] = _mm512_fmaddsub_pd(alpha_real, bv[1], bv_p[1]); + + _mm512_storeu_pd ((double *) &acur[i_1].real, bv[0]); + _mm512_storeu_pd ((double *) &acur[i_2].real, bv[1]); + + bv_p[0] = _mm512_permute_pd(bv[0], 0x55); + bv_p[1] = _mm512_permute_pd(bv[1], 0x55); + + for( j = 1; j < ni - 1; j = j + 2 ) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + i_4 = (j + 1) * *lda; + i_5 = i_1 + i_4; + + i_6 = i_2 + 4; + i_7 = i_5 + 4; + + // Load x from memory + x_real[0] = _mm512_set1_pd(acur[i_3].real); + x_img[0] = _mm512_set1_pd(acur[i_3].imag); + x_real[1] = _mm512_set1_pd(acur[i_4].real); + x_img[1] = _mm512_set1_pd(acur[i_4].imag); + + // Y := Y - b * x + xv0[0] = _mm512_mul_pd(x_img[0], bv_p[0]); + xv0[1] = _mm512_mul_pd(x_img[0], bv_p[1]); + xv0[0] = _mm512_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + xv0[1] = _mm512_fmaddsub_pd(x_real[0], bv[1], xv0[1]); + + xv1[0] = _mm512_mul_pd(x_img[1], bv_p[0]); + xv1[1] = _mm512_mul_pd(x_img[1], bv_p[1]); + xv1[0] = _mm512_fmaddsub_pd(x_real[1], bv[0], xv1[0]); + xv1[1] = _mm512_fmaddsub_pd(x_real[1], bv[1], xv1[1]); + + yv0[0] = _mm512_loadu_pd((double const *) &acur[i_2].real); + yv0[1] = _mm512_loadu_pd((double const *) &acur[i_6].real); + yv1[0] = _mm512_loadu_pd((double const *) &acur[i_5].real); + yv1[1] = _mm512_loadu_pd((double const *) &acur[i_7].real); + + yv0[0] = _mm512_sub_pd(yv0[0], xv0[0]); + yv0[1] = _mm512_sub_pd(yv0[1], xv0[1]); + yv1[0] = _mm512_sub_pd(yv1[0], xv1[0]); + yv1[1] = _mm512_sub_pd(yv1[1], xv1[1]); + + _mm512_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + _mm512_storeu_pd ((double *) &acur[i_6].real, yv0[1]); + _mm512_storeu_pd ((double *) &acur[i_5].real, yv1[0]); + _mm512_storeu_pd ((double *) &acur[i_7].real, yv1[1]); + } + if(ni - j > 0) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + i_4 = i_2 + 4; + + // Load x from memory + x_real[0] = _mm512_set1_pd(acur[i_3].real); + x_img[0] = _mm512_set1_pd(acur[i_3].imag); + + // Y := Y - b * x + xv0[0] = _mm512_mul_pd(x_img[0], bv_p[0]); + xv0[1] = _mm512_mul_pd(x_img[0], bv_p[1]); + xv0[0] = _mm512_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + xv0[1] = _mm512_fmaddsub_pd(x_real[0], bv[1], xv0[1]); + + yv0[0] = _mm512_loadu_pd((double const *) &acur[i_2].real); + yv0[1] = _mm512_loadu_pd((double const *) &acur[i_4].real); + + yv0[0] = _mm512_sub_pd(yv0[0], xv0[0]); + yv0[1] = _mm512_sub_pd(yv0[1], xv0[1]); + + _mm512_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + _mm512_storeu_pd ((double *) &acur[i_4].real, yv0[1]); + } + } + + // Updates 4 rows of trailing matrix per iteration + for(; i_1 < mi - 3; i_1+=4 ) + { + /*-----------Trailing matrix update for LU factorisation----------- + + A00 | a01 A02 + ----|----------- + a10 | alpha x + A20 | b Y + + b := alpha * b + Y := Y - b * x + + + SIMD algorithm: + + alpha = aR1 aI1 aR1 aI1 + bv = bR1 bI1 bR2 bI2 + bv_p = bI1 bR1 bI2 bR2 + xv = xR1 xI1 xR1 xI1 + yv = yR1 yI1 yR2 yI2 + + step 1 => b := alpha * b + bv = alpha * bv + bv_p = alpha * (-bv_p) + bv = bv - bv_p + bv_p = shuffle(bv) + + step 2 => Y := Y - b * x + temp = xv * bv + temp1 = xv * (-bv_p) + xv = temp0 - temp1 + yv = yv - xv + ------------------------------------------------------------------*/ + + i_2 = i_1 + 4; + + // Load alpha from memory + bv[0] = _mm512_loadu_pd((double const *) &acur[i_1].real); + bv_p[0] = _mm512_permute_pd(bv[0], 0x55); + + // b := alpha * b + bv_p[0] = _mm512_mul_pd(alpha_img, bv_p[0]); + bv[0] = _mm512_fmaddsub_pd(alpha_real, bv[0], bv_p[0]); + + _mm512_storeu_pd ((double *) &acur[i_1].real, bv[0]); + + bv_p[0] = _mm512_permute_pd(bv[0], 0x55); + + for( j = 1; j < ni - 1; j = j + 2 ) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + i_4 = (j + 1) * *lda; + i_5 = i_1 + i_4; + + i_6 = i_2 + 4; + i_7 = i_5 + 4; + + // Load x from memory + x_real[0] = _mm512_set1_pd(acur[i_3].real); + x_img[0] = _mm512_set1_pd(acur[i_3].imag); + x_real[1] = _mm512_set1_pd(acur[i_4].real); + x_img[1] = _mm512_set1_pd(acur[i_4].imag); + + // Y := Y - b * x + xv0[0] = _mm512_mul_pd(x_img[0], bv_p[0]); + xv0[0] = _mm512_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + + xv1[0] = _mm512_mul_pd(x_img[1], bv_p[0]); + xv1[0] = _mm512_fmaddsub_pd(x_real[1], bv[0], xv1[0]); + + yv0[0] = _mm512_loadu_pd((double const *) &acur[i_2].real); + yv1[0] = _mm512_loadu_pd((double const *) &acur[i_5].real); + + yv0[0] = _mm512_sub_pd(yv0[0], xv0[0]); + yv1[0] = _mm512_sub_pd(yv1[0], xv1[0]); + + _mm512_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + _mm512_storeu_pd ((double *) &acur[i_5].real, yv1[0]); + } + if(ni - j > 0) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + i_4 = i_2 + 4; + + // Load x from memory + x_real[0] = _mm512_set1_pd(acur[i_3].real); + x_img[0] = _mm512_set1_pd(acur[i_3].imag); + + // Y := Y - b * x + xv0[0] = _mm512_mul_pd(x_img[0], bv_p[0]); + xv0[0] = _mm512_fmaddsub_pd(x_real[0], bv[0], xv0[0]); + + yv0[0] = _mm512_loadu_pd((double const *) &acur[i_2].real); + + yv0[0] = _mm512_sub_pd(yv0[0], xv0[0]); + + _mm512_storeu_pd ((double *) &acur[i_2].real, yv0[0]); + } + } + + // Updates 1 row of trailing matrix per iteration + for( ; i_1 < mi; i_1++ ) + { + t_val = acur[i_1].real; + acur[i_1].real = (t_val * z__1.real - acur[i_1].imag * z__1.imag); + acur[i_1].imag = (t_val * z__1.imag + acur[i_1].imag * z__1.real); + + t_val = acur[i_1].real; + z_val = acur[i_1].imag; + + for( j = 1; j < ni - 1; j = j + 2 ) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + i_4 = (j + 1) * *lda; + i_5 = i_1 + i_4; + + acur[i_2].real = acur[i_2].real - t_val * acur[i_3].real + z_val * acur[i_3].imag; + acur[i_2].imag = acur[i_2].imag - t_val * acur[i_3].imag - z_val * acur[i_3].real; + + acur[i_5].real = acur[i_5].real - t_val * acur[i_4].real + z_val * acur[i_4].imag; + acur[i_5].imag = acur[i_5].imag - t_val * acur[i_4].imag - z_val * acur[i_4].real; + } + + if(ni - j > 0) + { + i_3 = j * *lda; + i_2 = i_1 + i_3; + + acur[i_2].real = acur[i_2].real - t_val * acur[i_3].real + z_val * acur[i_3].imag; + acur[i_2].imag = acur[i_2].imag - t_val * acur[i_3].imag - z_val * acur[i_3].real; + } + } + } + else + { + *info = ( *info == 0 ) ? p_idx + 1 : *info; + } + } + return 0; +} + +#endif diff --git a/src/lapack/x86/front/fla_lapack_x86_common.c b/src/lapack/x86/front/fla_lapack_x86_common.c index a46497967..d82f867ed 100644 --- a/src/lapack/x86/front/fla_lapack_x86_common.c +++ b/src/lapack/x86/front/fla_lapack_x86_common.c @@ -1,110 +1,236 @@ /****************************************************************************** * * Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. * *******************************************************************************/ - /*! @file fla_lapack_x86_common.c * @brief Common front-end functions * to choose optimized paths * * */ -#include "FLAME.h" - -#ifdef FLA_ENABLE_AMD_OPT +#include "fla_lapack_x86_common.h" +#include "fla_lapack_avx2_kernels.h" +#include "fla_lapack_avx512_kernels.h" +#if FLA_ENABLE_AMD_OPT /* 3x3 Householder Rotation */ int fla_dhrot3(integer *n, doublereal *a, integer *lda, doublereal *v, doublereal *tau) { - fla_dhrot3_avx2(n, a, lda, v, tau); + if (global_context.is_avx2) + { + fla_dhrot3_avx2(n, a, lda, v, tau); + } return 0; } - /* 2x2 Plane Rotation */ int fla_drot(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *c__, doublereal *s) { - fla_drot_avx2(n, dx, incx, dy, incy, c__, s); + if (global_context.is_avx2) + { + fla_drot_avx2(n, dx, incx, dy, incy, c__, s); + } return 0; } - int fla_zrot(integer *n, - doublecomplex *cx, integer *incx, - doublecomplex *cy, integer *incy, - doublereal *c__, doublecomplex *s) + doublecomplex *cx, integer *incx, + doublecomplex *cy, integer *incy, + doublereal *c__, doublecomplex *s) { - fla_zrot_avx2(n, cx, incx, cy, incy, c__, s); - return 0; + if (global_context.is_avx2) + { + fla_zrot_avx2(n, cx, incx, cy, incy, c__, s); + } + return 0; } - /* complex vector scaling when increment is 1 and specific threshold */ int fla_zscal(integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx) { /* Initialize global context data */ aocl_fla_init(); - /* Take AVX path only for increment equal to 1 and particular threshold size*/ - if(global_context.is_avx2 && *incx == 1 && *n <= FLA_ZSCAL_INLINE_SMALL) + if (global_context.is_avx2 && *incx == 1 && *n <= FLA_ZSCAL_INLINE_SMALL) { fla_zscal_ix1_avx2(n, alpha, x); } else { - zscal_(n, (dcomplex *) alpha,(dcomplex *) x, incx); + zscal_(n, (dcomplex *)alpha, (dcomplex *)x, incx); } return 0; } - /* scales a vector by a constant when threshold <= 128 */ int fla_dscal(integer *n, doublereal *da, doublereal *dx, integer *incx) { /* Initialize global context data */ aocl_fla_init(); - - if(global_context.is_avx2 && *incx == 1 && *da != 0 && *n >= 1 && *n <= FLA_DSCAL_INLINE_SMALL) + if (global_context.is_avx2 && *incx == 1 && *da != 0 && *n >= 1 && *n <= FLA_DSCAL_INLINE_SMALL) { fla_dscal_ix1_avx2(n, da, dx, incx); } else { dscal_(n, da, dx, incx); - } + } return 0; } - /* Double QR (DGEQRF) for small sizes */ int fla_dgeqrf_small(integer *m, integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *work) { - fla_dgeqrf_small_avx2(m, n, a, lda, tau, work); + if(global_context.is_avx2) + { + fla_dgeqrf_small_avx2(m, n, a, lda, tau, work); + } return 0; } - /* real vector scaling when increment is 1 */ int fla_sscal(integer *n, real *alpha, real *x, integer *incx) { /* Take AVX path only for increment equal to 1 */ - if(*incx == 1) + if (*incx == 1 && global_context.is_avx2) { fla_sscal_ix1_avx2(n, alpha, x); } else { - sscal_(n, (real *) alpha,(real *) x, incx); + sscal_(n, (real *)alpha, (real *)x, incx); } return 0; } - /* Rank 1 Operation */ int fla_sger(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *a, integer *lda) { - fla_sger_avx2(m, n, alpha, x, incx, y, incy, a, lda); + if (global_context.is_avx2) + { + fla_sger_avx2(m, n, alpha, x, incx, y, incy, a, lda); + } + return 0; +} + +/* LU factorization. + * To be used only when vectorized code via avx2/avx512 is enabled + * */ +int fla_dgetrf_small_simd(integer *m, integer *n, + doublereal *a, integer *lda, + integer *ipiv, integer *info) +{ + if(global_context.is_avx512) + { + fla_dgetrf_small_avx512(m, n, a, lda, ipiv, info); + } + else if (global_context.is_avx2) + { + fla_dgetrf_small_avx2(m, n, a, lda, ipiv, info); + } + return 0; +} + +/* Double Complex LU for small sizes, + * Optimized for AVX2 and AVX512 ISAs + */ +int fla_zgetrf_small_simd(integer *m, integer *n, + dcomplex *a, integer *lda, + integer *ipiv, integer *info) +{ + if(global_context.is_avx512) + { + fla_zgetrf_small_avx512(m, n, a, lda, ipiv, info); + } + else if(global_context.is_avx2) + { + fla_zgetrf_small_avx2(m, n, a, lda, ipiv, info); + } + else + { + lapack_zgetf2(m, n, a, lda, ipiv, info); + } + return 0; +} + +/* SVD for small tall-matrices in DGESVD + */ +void fla_dgesvd_nn_small10(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info) +{ + if(global_context.is_avx2) + { + fla_dgesvd_nn_small10_avx2(m, n, a, lda, s, work, info); + } + return; +} + +/* SVD for small fat-matrices with LQ factorization + * already computed + */ +void fla_dgesvd_small6(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *qr, integer *ldqr, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info) +{ + if(global_context.is_avx2) + { + fla_dgesvd_small6_avx2(m, n, a, lda, qr, ldqr, s, + u, ldu, vt, ldvt, work, info); + } + return; +} + +/* SVD for small fat-matrices for path 1T in DGESVD + */ +void fla_dgesvd_nn_small1T(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info) +{ + if(global_context.is_avx2) + { + fla_dgesvd_nn_small1T_avx2(m, n, a, lda, s, work, info); + } + return; +} + +/* SVD for small fat-matrices with LQ factorization + * already computed + */ +void fla_dgesvd_small6T(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *ql, integer *ldql, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info) +{ + if(global_context.is_avx2) + { + fla_dgesvd_small6T_avx2(m, n, a, lda, ql, ldql, s, + u, ldu, vt, ldvt, work, info); + } + return; +} + +/* Small DGETRS path (NOTRANS) should only be used for size between 3 to 8 and NRHS <= N */ +int fla_dgetrs_small_notrans(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info) +{ + if (global_context.is_avx2) + { + fla_dgetrs_small_trsm_ll_avx2(trans, n, nrhs, a, lda, ipiv, b, ldb, info); + } return 0; } #endif diff --git a/src/lapack/x86/front/fla_lapack_x86_common.h b/src/lapack/x86/front/fla_lapack_x86_common.h index 2991b118b..6a476438c 100644 --- a/src/lapack/x86/front/fla_lapack_x86_common.h +++ b/src/lapack/x86/front/fla_lapack_x86_common.h @@ -7,22 +7,62 @@ * to choose optimized paths * * */ -#ifdef FLA_ENABLE_AMD_OPT +#include "FLAME.h" + +#if FLA_ENABLE_AMD_OPT int fla_dhrot3(integer *n, - doublereal *a, integer *lda, - doublereal *v, doublereal *tau); + doublereal *a, integer *lda, + doublereal *v, doublereal *tau); int fla_drot(integer *n, - doublereal *dx, integer *incx, - doublereal *dy, integer *incy, - doublereal *c__, doublereal *s); + doublereal *dx, integer *incx, + doublereal *dy, integer *incy, + doublereal *c__, doublereal *s); int fla_zscal(integer *n, doublecomplex *alpha, - doublecomplex *x, integer *incx); + doublecomplex *x, integer *incx); int fla_dgeqrf_small(integer *m, integer *n, - doublereal *a, integer *lda, - doublereal *tau, doublereal *work); -int fla_sscal(integer *n, real *alpha, - real *x, integer *incx); + doublereal *a, integer *lda, + doublereal *tau, doublereal *work); +int fla_sscal(integer *n, real *alpha, + real *x, integer *incx); int fla_sger(integer *m, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *a, integer *lda); +int fla_zgetrf_small_simd(integer *m, integer *n, + dcomplex *a, integer *lda, + integer *ipiv, integer *info); +void fla_dgesvd_nn_small10(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info); +void fla_dgesvd_small6(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *qr, integer *ldqr, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info); +void fla_dgesvd_nn_small1T(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info); +void fla_dgesvd_small6T(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *ql, integer *ldql, + doublereal *s, + doublereal *u, integer *ldu, + doublereal *vt, integer *ldvt, + doublereal *work, + integer *info); +void fla_dgesvd_nn_small10(integer *m, integer *n, + doublereal *a, integer *lda, + doublereal *s, + doublereal *work, + integer *info); +int fla_dgetrs_small_notrans(char *trans, integer *n, + integer *nrhs, doublereal *a, + integer *lda, integer *ipiv, + doublereal *b, integer *ldb, integer *info); #endif diff --git a/src/lapacke/LAPACKE/src/lapacke_dgesvdq.c b/src/lapacke/LAPACKE/src/lapacke_dgesvdq.c index 8cda096d7..713f7fe19 100644 --- a/src/lapacke/LAPACKE/src/lapacke_dgesvdq.c +++ b/src/lapacke/LAPACKE/src/lapacke_dgesvdq.c @@ -48,7 +48,6 @@ lapack_int LAPACKE_dgesvdq( int matrix_layout, char joba, char jobp, lapack_int lrwork = -1; double* rwork = NULL; double rwork_query; - lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dgesvdq", -1 ); return -1; diff --git a/src/map/lapack2flamec/FLA_gebrd.c b/src/map/lapack2flamec/FLA_gebrd.c index 8b03e5443..f7315561a 100644 --- a/src/map/lapack2flamec/FLA_gebrd.c +++ b/src/map/lapack2flamec/FLA_gebrd.c @@ -26,116 +26,127 @@ be fixed to use complex datatypes for those diagonals. */ -extern TLS_CLASS_SPEC fla_bidiagut_t* fla_bidiagut_cntl_plain; - -#define LAPACK_gebrd(prefix) \ - int F77_ ## prefix ## gebrd( integer* m, \ - integer* n, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_A, integer* ldim_A, \ - PREFIX2LAPACK_REALDEF(prefix)* buff_d, \ - PREFIX2LAPACK_REALDEF(prefix)* buff_e, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_tu, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_tv, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_w, integer* lwork, \ - integer* info) - -#define LAPACK_gebrd_body(prefix) \ - FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ - FLA_Datatype dtype_re = PREFIX2FLAME_REALTYPE(prefix); \ - dim_t min_m_n = fla_min( *m, *n ); \ - dim_t m_d = min_m_n; \ - dim_t m_e = min_m_n - 1; \ - dim_t m_t = min_m_n; \ - FLA_Obj A, d, e, tu, tv, TU, TV, alpha; \ - FLA_Error init_result; \ - FLA_Uplo uplo; \ - integer apply_scale; \ - \ - FLA_Init_safe( &init_result ); \ - \ - FLA_Obj_create_without_buffer( datatype, *m, *n, &A ); \ - FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ - \ - uplo = ( *m >= *n ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR ); \ - \ - FLA_Obj_create_without_buffer( dtype_re, m_d, 1, &d ); \ - FLA_Obj_attach_buffer( buff_d, 1, m_d, &d ); \ - \ - FLA_Obj_create_without_buffer( dtype_re, m_e, 1, &e ); \ - if ( m_e > 0 ) FLA_Obj_attach_buffer( buff_e, 1, m_e, &e ); \ - \ - /* m_t is assumed to be same although it is different */ \ - FLA_Obj_create_without_buffer( datatype, m_t, 1, &tu ); \ - FLA_Obj_attach_buffer( buff_tu, 1, m_t, &tu ); \ - \ - FLA_Obj_create_without_buffer( datatype, m_t, 1, &tv ); \ - FLA_Obj_attach_buffer( buff_tv, 1, m_t, &tv ); \ - \ - FLA_Obj_create( dtype_re, 1, 1, 0, 0, &alpha ); \ - FLA_Max_abs_value( A, alpha ); \ - \ - apply_scale = \ - ( FLA_Obj_gt( alpha, FLA_OVERFLOW_SQUARE_THRES ) == TRUE ) - \ - ( FLA_Obj_lt( alpha, FLA_UNDERFLOW_SQUARE_THRES ) == TRUE ); \ - \ - if ( apply_scale ) \ - FLA_Scal( apply_scale > 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A ); \ - \ - FLA_Bidiag_UT_create_T( A, &TU, &TV ); \ - FLA_Set( FLA_ZERO, TU );FLA_Set( FLA_ZERO, TV ); \ - \ - FLA_Bidiag_UT_internal( A, TU, TV, fla_bidiagut_cntl_plain ); \ - \ - if ( apply_scale ) \ - FLA_Bidiag_UT_scale_diagonals( apply_scale < 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A ); \ - \ - if ( FLA_Obj_is_complex( A ) == TRUE ) { \ - FLA_Obj d2, e2, rL, rR; \ - \ - /* Temporary vectors to store diagonal and subdiagonal */ \ - FLA_Obj_create( datatype, m_d, 1, 0, 0, &d2 ); \ - if ( m_e > 0 ) FLA_Obj_create( datatype, m_e, 1, 0, 0, &e2 ); \ - \ - /* Temporary vectors to store realifying transformation */ \ - FLA_Obj_create( datatype, m_d, 1, 0, 0, &rL ); \ - FLA_Obj_create( datatype, m_d, 1, 0, 0, &rR ); \ - \ - /* Do not touch factors in A */ \ - FLA_Bidiag_UT_extract_diagonals( A, d2, e2 ); \ - FLA_Bidiag_UT_realify_diagonals( uplo, d2, e2, rL, rR ); \ - \ - FLA_Obj_extract_real_part( d2, d ); \ - if ( m_e > 0 ) FLA_Obj_extract_real_part( e2, e ); \ - \ - /* Clean up */ \ - FLA_Obj_free( &rL ); \ - FLA_Obj_free( &rR ); \ - FLA_Obj_free( &d2 ); \ - if ( m_e > 0 ) FLA_Obj_free( &e2 ); \ - } else { \ - FLA_Bidiag_UT_extract_real_diagonals( A, d, e ); \ - } \ - FLA_Bidiag_UT_recover_tau( TU, TV, tu, tv ); \ - \ - PREFIX2FLAME_INVERT_TAU(prefix,tu); \ - PREFIX2FLAME_INVERT_TAU(prefix,tv); \ - \ - FLA_Obj_free( &alpha ); \ - FLA_Obj_free( &TU ); \ - FLA_Obj_free( &TV ); \ - \ - FLA_Obj_free_without_buffer( &A ); \ - FLA_Obj_free_without_buffer( &d ); \ - FLA_Obj_free_without_buffer( &e ); \ - FLA_Obj_free_without_buffer( &tu ); \ - FLA_Obj_free_without_buffer( &tv ); \ - \ - FLA_Finalize_safe( init_result ); \ - \ - *info = 0; \ - +extern TLS_CLASS_SPEC fla_bidiagut_t *fla_bidiagut_cntl_plain; +#define LAPACK_gebrd(prefix) \ + int F77_##prefix##gebrd(integer *m, \ + integer *n, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_A, integer * ldim_A, \ + PREFIX2LAPACK_REALDEF(prefix) * buff_d, \ + PREFIX2LAPACK_REALDEF(prefix) * buff_e, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_tu, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_tv, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_w, integer * lwork, \ + integer * info) +#define LAPACK_gebrd_body(prefix) \ + FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ + FLA_Datatype dtype_re = PREFIX2FLAME_REALTYPE(prefix); \ + dim_t min_m_n = fla_min(*m, *n); \ + dim_t m_d = min_m_n; \ + dim_t m_e = min_m_n - 1; \ + dim_t m_t = min_m_n; \ + FLA_Obj A, d, e, tu, tv, TU, TV, alpha; \ + FLA_Error init_result; \ + FLA_Uplo uplo; \ + integer apply_scale; \ + \ + FLA_Init_safe(&init_result); \ + \ + FLA_Obj_create_without_buffer(datatype, *m, *n, &A); \ + FLA_Obj_attach_buffer(buff_A, 1, *ldim_A, &A); \ + \ + uplo = (*m >= *n ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR); \ + \ + FLA_Obj_create_without_buffer(dtype_re, m_d, 1, &d); \ + FLA_Obj_attach_buffer(buff_d, 1, m_d, &d); \ + \ + FLA_Obj_create_without_buffer(dtype_re, m_e, 1, &e); \ + if (m_e > 0) \ + FLA_Obj_attach_buffer(buff_e, 1, m_e, &e); \ + \ + /* m_t is assumed to be same although it is different */ \ + FLA_Obj_create_without_buffer(datatype, m_t, 1, &tu); \ + FLA_Obj_attach_buffer(buff_tu, 1, m_t, &tu); \ + \ + FLA_Obj_create_without_buffer(datatype, m_t, 1, &tv); \ + FLA_Obj_attach_buffer(buff_tv, 1, m_t, &tv); \ + \ + FLA_Obj_create(dtype_re, 1, 1, 0, 0, &alpha); \ + FLA_Max_abs_value(A, alpha); \ + \ + apply_scale = \ + (FLA_Obj_gt(alpha, FLA_OVERFLOW_SQUARE_THRES) == TRUE) - \ + (FLA_Obj_lt(alpha, FLA_UNDERFLOW_SQUARE_THRES) == TRUE); \ + \ + if (apply_scale) \ + FLA_Scal(apply_scale > 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A); \ + \ + FLA_Bidiag_UT_create_T(A, &TU, &TV); \ + FLA_Set(FLA_ZERO, TU); \ + FLA_Set(FLA_ZERO, TV); \ + \ + FLA_Bidiag_UT_internal(A, TU, TV, fla_bidiagut_cntl_plain); \ + \ + if (apply_scale) \ + FLA_Bidiag_UT_scale_diagonals(apply_scale < 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A); \ + \ + if (FLA_Obj_is_complex(A) == TRUE) \ + { \ + FLA_Obj d2, e2, rL, rR; \ + \ + /* Temporary vectors to store diagonal and subdiagonal */ \ + FLA_Obj_create(datatype, m_d, 1, 0, 0, &d2); \ + if (m_e > 0) \ + FLA_Obj_create(datatype, m_e, 1, 0, 0, &e2); \ + else \ + { \ + /* Creating object and freeing it to get rid of compiler warning */ \ + FLA_Obj_create(datatype, 1, 1, 0, 0, &e2); \ + FLA_Obj_free(&e2); \ + } \ + \ + /* Temporary vectors to store realifying transformation */ \ + FLA_Obj_create(datatype, m_d, 1, 0, 0, &rL); \ + FLA_Obj_create(datatype, m_d, 1, 0, 0, &rR); \ + \ + /* Do not touch factors in A */ \ + FLA_Bidiag_UT_extract_diagonals(A, d2, e2); \ + FLA_Bidiag_UT_realify_diagonals(uplo, d2, e2, rL, rR); \ + \ + FLA_Obj_extract_real_part(d2, d); \ + if (m_e > 0) \ + FLA_Obj_extract_real_part(e2, e); \ + \ + /* Clean up */ \ + FLA_Obj_free(&rL); \ + FLA_Obj_free(&rR); \ + FLA_Obj_free(&d2); \ + if (m_e > 0) \ + FLA_Obj_free(&e2); \ + } \ + else \ + { \ + FLA_Bidiag_UT_extract_real_diagonals(A, d, e); \ + } \ + FLA_Bidiag_UT_recover_tau(TU, TV, tu, tv); \ + \ + PREFIX2FLAME_INVERT_TAU(prefix, tu); \ + PREFIX2FLAME_INVERT_TAU(prefix, tv); \ + \ + FLA_Obj_free(&alpha); \ + FLA_Obj_free(&TU); \ + FLA_Obj_free(&TV); \ + \ + FLA_Obj_free_without_buffer(&A); \ + FLA_Obj_free_without_buffer(&d); \ + FLA_Obj_free_without_buffer(&e); \ + FLA_Obj_free_without_buffer(&tu); \ + FLA_Obj_free_without_buffer(&tv); \ + \ + FLA_Finalize_safe(init_result); \ + \ + *info = 0; LAPACK_gebrd(s) { @@ -143,18 +154,19 @@ LAPACK_gebrd(s) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgebrd inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( sgebrd_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, lwork, - info ), fla_error ) + LAPACK_RETURN_CHECK_VAR1(sgebrd_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, lwork, + info), + fla_error) } - if(fla_error==LAPACK_SUCCESS) + if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(s) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -165,18 +177,19 @@ LAPACK_gebrd(d) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgebrd inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( dgebrd_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, lwork, - info ), fla_error ) + LAPACK_RETURN_CHECK_VAR1(dgebrd_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(d) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -189,18 +202,19 @@ LAPACK_gebrd(c) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cgebrd inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( cgebrd_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, lwork, - info ), fla_error ) + LAPACK_RETURN_CHECK_VAR1(cgebrd_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(c) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -211,34 +225,35 @@ LAPACK_gebrd(z) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgebrd inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( zgebrd_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, lwork, - info ),fla_error ) + LAPACK_RETURN_CHECK_VAR1(zgebrd_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(z) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; } #endif -#define LAPACK_gebd2(prefix) \ - int F77_ ## prefix ## gebd2( integer* m, \ - integer* n, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_A, integer* ldim_A, \ - PREFIX2LAPACK_REALDEF(prefix)* buff_d, \ - PREFIX2LAPACK_REALDEF(prefix)* buff_e, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_tu, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_tv, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_w, \ - integer* info ) +#define LAPACK_gebd2(prefix) \ + int F77_##prefix##gebd2(integer *m, \ + integer *n, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_A, integer * ldim_A, \ + PREFIX2LAPACK_REALDEF(prefix) * buff_d, \ + PREFIX2LAPACK_REALDEF(prefix) * buff_e, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_tu, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_tv, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_w, \ + integer * info) LAPACK_gebd2(s) { @@ -246,18 +261,19 @@ LAPACK_gebd2(s) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgebd2 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( sgebd2_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, - info ), fla_error) + LAPACK_RETURN_CHECK_VAR1(sgebd2_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(s) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -268,17 +284,18 @@ LAPACK_gebd2(d) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgebd2 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( dgebd2_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, - info ), fla_error) + LAPACK_RETURN_CHECK_VAR1(dgebd2_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(d) - fla_error=0; + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -291,18 +308,19 @@ LAPACK_gebd2(c) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cgebd2 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( cgebd2_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, - info ),fla_error ) + LAPACK_RETURN_CHECK_VAR1(cgebd2_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(c) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -313,18 +331,19 @@ LAPACK_gebd2(z) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgebd2 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1( zgebd2_check( m, n, - buff_A, ldim_A, - buff_d, buff_e, - buff_tu, buff_tv, - buff_w, - info ), fla_error ) + LAPACK_RETURN_CHECK_VAR1(zgebd2_check(m, n, + buff_A, ldim_A, + buff_d, buff_e, + buff_tu, buff_tv, + buff_w, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_gebrd_body(z) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; diff --git a/src/map/lapack2flamec/FLA_geqpf.c b/src/map/lapack2flamec/FLA_geqpf.c index 26dc62b9f..36c49d76a 100644 --- a/src/map/lapack2flamec/FLA_geqpf.c +++ b/src/map/lapack2flamec/FLA_geqpf.c @@ -102,8 +102,9 @@ extern int dgeqpf_fla(integer *m, integer *n, doublereal *a, integer * lda, inte \ /* - LAPACK path is enabled for both {S,D}GEQPF when FLA_AMD_OPT is set to to - fix the incorrect results and NANs observed while testing xGEQPF. + LAPACK path is enabled for both {S,D}GEQPF when FLA_ENABLE_AMD_OPT + is set to to fix the incorrect results and NANs observed while + testing xGEQPF. */ LAPACK_geqpf(s) @@ -111,7 +112,7 @@ LAPACK_geqpf(s) int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgeqpf inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT { for ( int i=0; i<*n; ++i) buff_p[i] = (i+1); } @@ -150,7 +151,7 @@ LAPACK_geqpf(d) int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgeqpf inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT { for ( int i=0; i<*n; ++i) buff_p[i] = (i+1); } @@ -262,7 +263,7 @@ LAPACK_geqp3(s) AOCL_DTL_SNPRINTF("sgeqp3 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); extern int sgeqp3_fla(integer *m, integer *n, real *a, integer *lda, integer *jpvt, real *tau, real *work, integer *lwork, integer *info); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(sgeqp3_check(m, n, @@ -312,7 +313,7 @@ LAPACK_geqp3(d) AOCL_DTL_SNPRINTF("dgeqp3 inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); extern int dgeqp3_fla(integer *m, integer *n, doublereal *a, integer * lda, integer *jpvt, doublereal *tau, doublereal *work, integer *lwork, integer *info); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dgeqp3_check( m, n, diff --git a/src/map/lapack2flamec/FLA_geqrf.c b/src/map/lapack2flamec/FLA_geqrf.c index be09df24a..c795a792a 100644 --- a/src/map/lapack2flamec/FLA_geqrf.c +++ b/src/map/lapack2flamec/FLA_geqrf.c @@ -85,7 +85,7 @@ LAPACK_geqrf(s) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgeqrf inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", lwork %" FLA_IS "", *m, *n, *ldim_A, *lwork); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sgeqrf_check( m, n, @@ -114,7 +114,7 @@ LAPACK_geqrf(d) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgeqrf inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", lwork %" FLA_IS "", *m, *n, *ldim_A, *lwork); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(dgeqrf_check(m, n, @@ -298,7 +298,7 @@ LAPACK_geqrfp(s) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgeqrfp inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sgeqrfp_check( m, n, @@ -331,7 +331,7 @@ LAPACK_geqrfp(d) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgeqrfp inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(dgeqrfp_check(m, n, @@ -418,7 +418,7 @@ LAPACK_geqr2p(s) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgeqr2p inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sgeqr2p_check( m, n, @@ -451,7 +451,7 @@ LAPACK_geqr2p(d) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgeqr2p inputs: m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS "", *m, *n, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(dgeqr2p_check(m, n, diff --git a/src/map/lapack2flamec/FLA_gesdd.c b/src/map/lapack2flamec/FLA_gesdd.c index 116d53047..3df191278 100644 --- a/src/map/lapack2flamec/FLA_gesdd.c +++ b/src/map/lapack2flamec/FLA_gesdd.c @@ -107,7 +107,7 @@ LAPACK_gesdd_real(s) extern int sgesdd_fla_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, integer *lda, float *s, float *u, integer *ldu, float *vt, integer *ldvt, float *work, integer *lwork, integer *info); extern int lapack_sgesdd(char *jobz, integer *m, integer *n, real *a, integer *lda, real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work, integer *lwork, integer *iwork, integer *info); -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { if(*m > 750 || *n > 750){ char jobu[1], jobv[1]; @@ -206,7 +206,7 @@ LAPACK_gesdd_real(d) AOCL_DTL_SNPRINTF("dgesdd inputs: jobz %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS ", lwork %" FLA_IS "", *jobz, *m, *n, *ldim_A, *ldim_U, *ldim_Vh, *lwork); extern int lapack_dgesdd(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, doublereal *s, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork, integer *iwork, integer *info); -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { LAPACK_RETURN_CHECK_VAR1( dgesdd_check( jobz, m, n, diff --git a/src/map/lapack2flamec/FLA_gesvd.c b/src/map/lapack2flamec/FLA_gesvd.c index 819817a3a..d13d38e1a 100644 --- a/src/map/lapack2flamec/FLA_gesvd.c +++ b/src/map/lapack2flamec/FLA_gesvd.c @@ -36,6 +36,13 @@ Note that the routine returns V**T, not V. */ +extern int lapack_sgesvd(char *jobu, char *jobvt, integer *m, integer *n, real *a, integer *lda, real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work, integer *lwork, integer *info); +extern int lapack_dgesvd(char *jobu, char *jobvt, integer *m, integer *n, doublereal *a, integer *lda, doublereal *s, doublereal *u, integer * ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork, integer *info); +extern int sgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, integer *lda, float *s, float *u, integer *ldu, float *vt, integer *ldvt, float *work, integer *lwork, integer *info); +extern int dgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, double *a, integer *lda, double *s, double *u, integer * ldu, double *vt, integer *ldvt, double *work, integer *lwork, integer *info); +extern int cgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, scomplex *a, integer *lda, float *s, scomplex *u, integer *ldu, scomplex * vt, integer *ldvt, scomplex *work, integer *lwork, float *rwork, integer *info); +extern int zgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, dcomplex *a, integer *lda, double *s, dcomplex *u, integer *ldu, dcomplex *vt, integer *ldvt, dcomplex *work, integer *lwork, double *rwork, integer *info); + #define LAPACK_gesvd_real(prefix) \ int F77_ ## prefix ## gesvd( char* jobu, \ char* jobv, \ @@ -134,7 +141,7 @@ LAPACK_gesvd_real(s) int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgesvd inputs: jobu %c, jobvt %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS "", *jobu, *jobv, *m, *n, *ldim_A, *ldim_U, *ldim_Vh); -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { lapack_sgesvd ( jobu, jobv, m, n, buff_A, ldim_A, buff_s, buff_U, ldim_U,buff_Vh , ldim_Vh, buff_w, lwork,info ); /** fla_error set to *info on LAPACK_SUCCESS */ @@ -169,7 +176,7 @@ LAPACK_gesvd_real(d) int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgesvd inputs: jobu %c, jobvt %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS "", *jobu, *jobv, *m, *n, *ldim_A, *ldim_U, *ldim_Vh); -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { /* Initialize global context data */ aocl_fla_init(); diff --git a/src/map/lapack2flamec/FLA_getrf.c b/src/map/lapack2flamec/FLA_getrf.c index af70857ea..b13a4014b 100644 --- a/src/map/lapack2flamec/FLA_getrf.c +++ b/src/map/lapack2flamec/FLA_getrf.c @@ -9,7 +9,7 @@ */ /* - Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. */ #include "FLAME.h" @@ -19,6 +19,8 @@ #include "FLA_lapack2flame_util_defs.h" #include "FLA_lapack2flame_return_defs.h" #include "FLA_lapack2flame_prototypes.h" +#include "fla_lapack_x86_common.h" +#include "fla_lapack_avx2_kernels.h" /* GETRF computes an LU factorization of a general M-by-N matrix A @@ -41,8 +43,6 @@ extern void DTL_Trace( uint32 ui32LineNumber, const int8 *pi8Message); -#define FLA_ENABLE_ALT_PATH 0 - #define LAPACK_getrf(prefix) \ int F77_ ## prefix ## getrf( integer* m, \ integer* n, \ @@ -52,90 +52,89 @@ extern void DTL_Trace( #ifndef FLA_ENABLE_SUPERMATRIX -#if FLA_AMD_OPT /* FLA_AMD_OPT */ -/* FLA_AMD_OPT enables the code which selects algorithm variants based on size */ +#if FLA_ENABLE_AMD_OPT /* FLA_ENABLE_AMD_OPT */ +/* FLA_ENABLE_AMD_OPT enables the code which selects algorithm variants based on size */ #define LAPACK_getrf_body_d(prefix) \ extern fla_context global_context; \ - if(global_context.is_avx2 && *m < FLA_DGETRF_SMALL_THRESH0 && *n < FLA_DGETRF_SMALL_THRESH0 ) \ + if(*m <= FLA_DGETRF_SMALL_THRESH0 && *n <= FLA_DGETRF_SMALL_THRESH0) \ { \ - fla_lu_piv_small_d_avx2( m, n, buff_A, ldim_A, buff_p, info ); \ + FLA_LU_piv_small_d_var0( m, n, buff_A, ldim_A, buff_p, info); \ } \ else \ { \ - dgetrf2_( m, n, buff_A, ldim_A, buff_p, info); \ - } + /* Initialize global context data */ \ + aocl_fla_init(); \ + if(global_context.is_avx2 && *m < FLA_DGETRF_SMALL_AVX2_THRESH0 && *n < FLA_DGETRF_SMALL_AVX2_THRESH0) \ + { \ + /* Calling vectorized code when avx2 supported architecture detected */ \ + fla_dgetrf_small_avx2( m, n, buff_A, ldim_A, buff_p, info ); \ + } \ + else \ + { \ + dgetrf2_( m, n, buff_A, ldim_A, buff_p, info); \ + } \ + } \ #ifdef FLA_OPENMP_MULTITHREADING - #define LAPACK_getrf_body_z(prefix) \ - if( *m <= FLA_ZGETRF_SMALL_THRESH0 && *n <= FLA_ZGETRF_SMALL_THRESH0 ) \ - { \ - fla_zgetrf_small_avx2( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info ); \ - } \ - else if( *m <= FLA_ZGETRF_SMALL_THRESH1 && *n <= FLA_ZGETRF_SMALL_THRESH1 ) \ - { \ - FLA_LU_piv_z_var0( m, n, buff_A, ldim_A, buff_p, info); \ - } \ - else \ - { \ - FLA_LU_piv_z_var1_parallel( m, n, (doublecomplex *) buff_A, ldim_A, buff_p, info); \ - } + #define LAPACK_getrf_body_z(prefix) \ + if( *m <= FLA_ZGETRF_SMALL_THRESH && *n <= FLA_ZGETRF_SMALL_THRESH ) \ + { \ + FLA_LU_piv_z_var0( m, n, buff_A, ldim_A, buff_p, info ); \ + } \ + else \ + { \ + FLA_LU_piv_z_parallel( m, n, buff_A, ldim_A, buff_p, info); \ + } #else - #define LAPACK_getrf_body_z(prefix) \ - if( *m <= FLA_ZGETRF_SMALL_THRESH0 && *n <= FLA_ZGETRF_SMALL_THRESH0 ) \ - { \ - fla_zgetrf_small_avx2( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info ); \ - } \ - else \ - { \ - FLA_LU_piv_z_var0( m, n, buff_A, ldim_A, buff_p, info); \ - } + #define LAPACK_getrf_body_z(prefix) \ + FLA_LU_piv_z_var0( m, n, buff_A, ldim_A, buff_p, info); #endif -#define LAPACK_getrf_body_s(prefix) \ - FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ - FLA_Obj A, p; \ - integer min_m_n = fla_min( *m, *n ); \ - FLA_Error e_val = FLA_SUCCESS; \ - FLA_Error init_result; \ - extern fla_context global_context; \ - \ - if( *m <= FLA_SGETRF_SMALL_THRESH0 && *n <= FLA_SGETRF_SMALL_THRESH0 ) \ - { \ - FLA_LU_piv_small_s_var0( m, n, buff_A, ldim_A, buff_p, info ); \ - } \ - else if( global_context.is_avx2 && *m <= FLA_SGETRF_SMALL_THRESH1 && *n <= FLA_SGETRF_SMALL_THRESH1 ) \ - { \ - FLA_LU_piv_small_s_var1( m, n, buff_A, ldim_A, buff_p, info ); \ - } \ - else if( *m <= FLA_SGETRF_MEDIUM_THRESH0 && *n <= FLA_SGETRF_MEDIUM_THRESH0 ) \ - { \ - FLA_Init_safe( &init_result ); \ - \ - FLA_Obj_create_without_buffer( datatype, *m, *n, &A ); \ - FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ - \ - FLA_Obj_create_without_buffer( FLA_INT, min_m_n, 1, &p ); \ - FLA_Obj_attach_buffer( buff_p, 1, min_m_n, &p ); \ - \ - e_val = FLA_LU_piv( A, p ); \ - FLA_Shift_pivots_to( FLA_LAPACK_PIVOTS, p ); \ - \ - FLA_Obj_free_without_buffer( &A ); \ - FLA_Obj_free_without_buffer( &p ); \ - \ - FLA_Finalize_safe( init_result ); \ - if ( e_val != FLA_SUCCESS ) *info = e_val + 1; \ - } \ - else \ - { \ - sgetrf2_( m, n, (float *)buff_A, ldim_A, buff_p, info); \ +#define LAPACK_getrf_body_s(prefix) \ + FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ + FLA_Obj A, p; \ + integer min_m_n = fla_min( *m, *n ); \ + FLA_Error e_val = FLA_SUCCESS; \ + FLA_Error init_result; \ + extern fla_context global_context; \ + \ + if( *m <= FLA_SGETRF_SMALL_THRESH0 && *n <= FLA_SGETRF_SMALL_THRESH0 ) \ + { \ + FLA_LU_piv_small_s_var0( m, n, buff_A, ldim_A, buff_p, info ); \ + } \ + else if( global_context.is_avx2 && *m <= FLA_SGETRF_SMALL_THRESH1 && *n <= FLA_SGETRF_SMALL_THRESH1 ) \ + { \ + FLA_LU_piv_small_s_var1( m, n, buff_A, ldim_A, buff_p, info ); \ + } \ + else if( *m <= FLA_SGETRF_MEDIUM_THRESH0 && *n <= FLA_SGETRF_MEDIUM_THRESH0 ) \ + { \ + FLA_Init_safe( &init_result ); \ + \ + FLA_Obj_create_without_buffer( datatype, *m, *n, &A ); \ + FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ + \ + FLA_Obj_create_without_buffer( FLA_INT, min_m_n, 1, &p ); \ + FLA_Obj_attach_buffer( buff_p, 1, min_m_n, &p ); \ + \ + e_val = FLA_LU_piv( A, p ); \ + FLA_Shift_pivots_to( FLA_LAPACK_PIVOTS, p ); \ + \ + FLA_Obj_free_without_buffer( &A ); \ + FLA_Obj_free_without_buffer( &p ); \ + \ + FLA_Finalize_safe( init_result ); \ + if ( e_val != FLA_SUCCESS ) *info = e_val + 1; \ + } \ + else \ + { \ + sgetrf2_( m, n, (float *)buff_A, ldim_A, buff_p, info); \ } -#else /* FLA_AMD_OPT */ +#else /* FLA_ENABLE_AMD_OPT */ #define LAPACK_getrf_body_z LAPACK_getrf_body @@ -168,70 +167,71 @@ extern fla_context global_context; \ if ( e_val != FLA_SUCCESS ) *info = e_val + 1; -#endif /* FLA_AMD_OPT */ +#endif /* FLA_ENABLE_AMD_OPT */ // Note that p should be set zero. #define LAPACK_getrf_body(prefix) \ FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ FLA_Obj A, p; \ - integer min_m_n = fla_min( *m, *n ); \ + integer min_m_n = fla_min( *m, *n ); \ FLA_Error e_val = FLA_SUCCESS; \ FLA_Error init_result; \ FLA_Bool skip = FALSE; \ \ \ - if( *m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL && !FLA_ENABLE_ALT_PATH ) /* Small sizes- lapack path */ \ + if( *m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL ) /* Small sizes- lapack path */ \ { \ switch(datatype) \ { \ case FLA_FLOAT: \ - { lapack_sgetrf( m, n, (float *)buff_A, ldim_A, buff_p, info); break; } \ + { lapack_sgetrf( m, n, (float *)buff_A, ldim_A, buff_p, info); break; } \ case FLA_COMPLEX: \ - { lapack_cgetrf( m, n, (scomplex *)buff_A, ldim_A, buff_p, info); break; } \ + { lapack_cgetrf( m, n, (scomplex *)buff_A, ldim_A, buff_p, info); break; } \ case FLA_DOUBLE_COMPLEX: \ - { lapack_zgetrf( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info); break; } \ + { lapack_zgetrf( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info); break; } \ } if ( *info != 0 ) skip = TRUE; \ \ } \ else if( ( datatype == FLA_FLOAT && *m < FLA_GETRF_FLOAT && * n < FLA_GETRF_FLOAT )|| \ ( datatype == FLA_COMPLEX && *m < FLA_GETRF_COMPLEX && *n < FLA_GETRF_COMPLEX ) || \ ( datatype == FLA_DOUBLE_COMPLEX && *m < FLA_GETRF_DOUBLE_COMPLEX && *n < FLA_GETRF_DOUBLE_COMPLEX ) ) \ - { \ - FLA_Init_safe( &init_result ); \ - \ - FLA_Obj_create_without_buffer( datatype, *m, *n, &A ); \ - FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ - \ - FLA_Obj_create_without_buffer( FLA_INT, min_m_n, 1, &p ); \ - FLA_Obj_attach_buffer( buff_p, 1, min_m_n, &p ); \ - \ - e_val = FLA_LU_piv( A, p ); \ - FLA_Shift_pivots_to( FLA_LAPACK_PIVOTS, p ); \ - \ - FLA_Obj_free_without_buffer( &A ); \ - FLA_Obj_free_without_buffer( &p ); \ - \ - FLA_Finalize_safe( init_result ); \ - } \ - else \ - { \ - switch(datatype) \ - { \ - case FLA_FLOAT: \ - { sgetrf2_( m, n, (float *)buff_A, ldim_A, buff_p, info); break; } \ - case FLA_COMPLEX: \ - { cgetrf2_( m, n, (scomplex *)buff_A, ldim_A, buff_p, info); break; } \ - case FLA_DOUBLE_COMPLEX: \ - { zgetrf2_( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info); break; } \ - } if ( *info != 0 ) skip = TRUE; \ - \ - } \ - \ - if ( e_val != FLA_SUCCESS ) *info = e_val + 1; \ + { \ + FLA_Init_safe( &init_result ); \ + \ + FLA_Obj_create_without_buffer( datatype, *m, *n, &A ); \ + FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ + \ + FLA_Obj_create_without_buffer( FLA_INT, min_m_n, 1, &p ); \ + FLA_Obj_attach_buffer( buff_p, 1, min_m_n, &p ); \ + \ + e_val = FLA_LU_piv( A, p ); \ + FLA_Shift_pivots_to( FLA_LAPACK_PIVOTS, p ); \ + \ + FLA_Obj_free_without_buffer( &A ); \ + FLA_Obj_free_without_buffer( &p ); \ + \ + FLA_Finalize_safe( init_result ); \ + } \ + else \ + { \ + switch(datatype) \ + { \ + case FLA_FLOAT: \ + { sgetrf2_( m, n, (float *)buff_A, ldim_A, buff_p, info); break; } \ + case FLA_COMPLEX: \ + { cgetrf2_( m, n, (scomplex *)buff_A, ldim_A, buff_p, info); break; } \ + case FLA_DOUBLE_COMPLEX: \ + { zgetrf2_( m, n, (dcomplex *)buff_A, ldim_A, buff_p, info); break; } \ + } if ( *info != 0 ) skip = TRUE; \ + \ + } \ + \ + if ( e_val != FLA_SUCCESS ) *info = e_val + 1; \ else if( skip != TRUE ) *info = 0; #else /* FLA_ENABLE_SUPERMATRIX */ +#define LAPACK_getrf_body_s LAPACK_getrf_body #define LAPACK_getrf_body_d LAPACK_getrf_body #define LAPACK_getrf_body_z LAPACK_getrf_body @@ -239,7 +239,7 @@ extern fla_context global_context; #define LAPACK_getrf_body(prefix) \ FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ FLA_Obj A, p, AH, ph; \ - integer min_m_n = fla_min( *m, *n ); \ + integer min_m_n = fla_min( *m, *n ); \ dim_t nth, b_flash; \ FLA_Error e_val; \ FLA_Error init_result; \ @@ -316,10 +316,8 @@ LAPACK_getrf(d) } if (fla_error == LAPACK_SUCCESS) { - /* Initialize global context data */ - aocl_fla_init(); LAPACK_getrf_body_d(d) - /** fla_error set to 0 on LAPACK_SUCCESS */ + /* fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/FLA_hegst.c b/src/map/lapack2flamec/FLA_hegst.c index 1e2ed51e3..892b59a5f 100644 --- a/src/map/lapack2flamec/FLA_hegst.c +++ b/src/map/lapack2flamec/FLA_hegst.c @@ -16,6 +16,11 @@ #include "FLA_lapack2flame_return_defs.h" #include "FLA_lapack2flame_prototypes.h" +extern int zhegst_fla(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *info); +extern int chegst_fla(integer *itype, char *uplo, integer *n, complex * a, integer *lda, complex *b, integer *ldb, integer *info); +extern int chegs2_fla(integer *itype, char *uplo, integer *n, complex * a, integer *lda, complex *b, integer *ldb, integer *info); +extern int zhegs2_fla(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *info); + /* ZHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form. @@ -38,7 +43,7 @@ \ FLA_Init_safe( &init_result ); \ \ - FLA_Param_map_netlib_to_flame_inv( itype, &inv_fla ); \ + FLA_Param_map_netlib_to_flame_inv( (int *) itype, &inv_fla ); \ FLA_Param_map_netlib_to_flame_uplo( uplo, &uplo_fla ); \ \ FLA_Obj_create_without_buffer( datatype, *m, *m, &A ); \ @@ -103,9 +108,10 @@ LAPACK_hegst(d,sy) } LAPACK_hegst(c,he) { - int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("chegst inputs: itype %" FLA_IS ", uplo %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "", *itype, *uplo, *m, *ldim_A, *ldim_B); +#if !FLA_ENABLE_AMD_OPT + int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( chegst_check( itype, uplo, m, @@ -116,17 +122,29 @@ LAPACK_hegst(c,he) if (fla_error == LAPACK_SUCCESS) { LAPACK_hegst_body(c) - /** fla_error set to 0 on LAPACK_SUCCESS */ + /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; +#else + { + chegst_fla( itype, uplo, + m, + (complex *) buff_A, ldim_A, + (complex *) buff_B, ldim_B, + info ); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif } LAPACK_hegst(z,he) { - int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zhegst inputs: itype %" FLA_IS ", uplo %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "", *itype, *uplo, *m, *ldim_A, *ldim_B); +#if !FLA_ENABLE_AMD_OPT + int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( zhegst_check( itype, uplo, m, @@ -137,11 +155,22 @@ LAPACK_hegst(z,he) if (fla_error == LAPACK_SUCCESS) { LAPACK_hegst_body(z) - /** fla_error set to 0 on LAPACK_SUCCESS */ + /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; +#else + { + zhegst_fla( itype, uplo, + m, + (doublecomplex *) buff_A, ldim_A, + (doublecomplex *) buff_B, ldim_B, + info ); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif } @@ -197,9 +226,10 @@ LAPACK_hegs2(d,sy) } LAPACK_hegs2(c,he) { - int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("chegs2 inputs: itype %" FLA_IS ", uplo %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "", *itype, *uplo, *m, *ldim_A, *ldim_B); +#if !FLA_ENABLE_AMD_OPT + int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( chegs2_check( itype, uplo, m, @@ -209,18 +239,30 @@ LAPACK_hegs2(c,he) } if (fla_error == LAPACK_SUCCESS) { - LAPACK_hegst_body(c) + LAPACK_hegst_body(c) /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; +#else + { + chegs2_fla( itype, uplo, + m, + (complex *) buff_A, ldim_A, + (complex *) buff_B, ldim_B, + info ); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif } LAPACK_hegs2(z,he) { - int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zhegs2 inputs: itype %" FLA_IS ", uplo %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "", *itype, *uplo, *m, *ldim_A, *ldim_B); +#if !FLA_ENABLE_AMD_OPT + int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( zhegs2_check( itype, uplo, m, @@ -230,12 +272,23 @@ LAPACK_hegs2(z,he) } if (fla_error == LAPACK_SUCCESS) { - LAPACK_hegst_body(z) + LAPACK_hegst_body(z) /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; +#else + { + zhegs2_fla( itype, uplo, + m, + (doublecomplex *) buff_A, ldim_A, + (doublecomplex *) buff_B, ldim_B, + info ); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif } diff --git a/src/map/lapack2flamec/FLA_hetrd.c b/src/map/lapack2flamec/FLA_hetrd.c index 58e11215d..63ad5df85 100644 --- a/src/map/lapack2flamec/FLA_hetrd.c +++ b/src/map/lapack2flamec/FLA_hetrd.c @@ -182,8 +182,7 @@ LAPACK_hetrd(d,sy) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("hetrd-dsytrd inputs: uplo %c, n %" FLA_IS ", lda %" FLA_IS "", *uplo, *m, *ldim_A); { - - #if !FLA_AMD_OPT + #if !FLA_ENABLE_AMD_OPT if ( *uplo == 'U' || *uplo == 'u' ) #endif { diff --git a/src/map/lapack2flamec/FLA_lapack2flame_return_defs.h b/src/map/lapack2flamec/FLA_lapack2flame_return_defs.h index b37f42758..155390720 100644 --- a/src/map/lapack2flamec/FLA_lapack2flame_return_defs.h +++ b/src/map/lapack2flamec/FLA_lapack2flame_return_defs.h @@ -7,8 +7,13 @@ directory, or at http://opensource.org/licenses/BSD-3-Clause */ - +/* + * Modifications Copyright (c) 2021-2023 Advanced Micro Devices, Inc.  All rights reserved. + */ #include "FLAME.h" +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif #ifndef FLA_LAPACK2FLAME_RETURN_DEFS_H #define FLA_LAPACK2FLAME_RETURN_DEFS_H @@ -50,8 +55,10 @@ switch ( r_val ) \ } \ } -extern int lsame_(char *, char *); -extern int xerbla_(char *, integer *); +#ifndef FLA_ENABLE_AOCL_BLAS +extern int lsame_(char *, char *, integer a, integer b); +extern int xerbla_(const char *srname, const integer *info, ftnlen srname_len); +#endif extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); diff --git a/src/map/lapack2flamec/FLA_orgbr.c b/src/map/lapack2flamec/FLA_orgbr.c index 6a6d0c674..9121bf095 100644 --- a/src/map/lapack2flamec/FLA_orgbr.c +++ b/src/map/lapack2flamec/FLA_orgbr.c @@ -35,160 +35,185 @@ P**T as an N-by-N matrix. */ -#define LAPACK_orgbr(prefix, name) \ - int F77_ ## prefix ## name ## br( char* vect, \ - integer* m, \ - integer* n, \ - integer* k, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_A, integer* ldim_A, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_t, \ - PREFIX2LAPACK_TYPEDEF(prefix)* buff_w, \ - integer* lwork, \ - integer* info ) +#define LAPACK_orgbr(prefix, name) \ + int F77_##prefix##name##br(char *vect, \ + integer *m, \ + integer *n, \ + integer *k, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_A, integer * ldim_A, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_t, \ + PREFIX2LAPACK_TYPEDEF(prefix) * buff_w, \ + integer * lwork, \ + integer * info) // buff_t shoud not include any zero. if it has one, that is the right dimension to go. -#define LAPACK_orgbr_body(prefix) \ - FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ - FLA_Obj A, ATL, ATR, ABL, ABR, A1, A2, Ah, T, TL, TR, t; \ - FLA_Error init_result; \ - FLA_Uplo uplo; \ - dim_t m_A, n_A, m_t; \ - \ - FLA_Init_safe( &init_result ); \ - \ - m_A = *m; n_A = *n; \ - \ - /* A is assumed to m x k for 'Q' and k x n for 'Q'. */ \ - if ( *vect == 'Q' ) { \ - uplo = ( *m >= *k ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR ); \ - m_t = fla_min( *m, *k ); \ - } else {/*( *vect == 'P' ) */ \ - uplo = ( *k >= *n ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR ); \ - m_t = fla_min( *k, *n ); \ - } \ - \ - FLA_Obj_create_without_buffer( datatype, m_A, n_A, &A ); \ - FLA_Obj_attach_buffer( buff_A, 1, *ldim_A, &A ); \ - \ - FLA_Obj_create_without_buffer( datatype, m_t, 1, &t ); \ - if ( m_t > 0 ) { \ - FLA_Obj_attach_buffer( buff_t, 1, m_t, &t ); \ - PREFIX2FLAME_INVERT_TAU(prefix,t); \ - } \ - \ - FLA_Part_2x2( A, &ATL, &ATR, \ - &ABL, &ABR, m_t, m_t, FLA_TL ); \ - \ - /* Accumulate house-holder vectors */ \ - if ( *vect == 'Q' ) { /* U */ \ - FLA_Part_2x1( ATL, &A1, \ - &A2, ( uplo == FLA_LOWER_TRIANGULAR ), FLA_TOP );\ - FLA_Merge_2x1( A2, \ - ABL, &Ah ); \ - FLA_Merge_2x1( ATL, \ - ABL, &A2 ); \ - FLA_Part_2x1( t, &t, \ - &T, FLA_Obj_min_dim( Ah ), FLA_TOP ); \ - \ - FLA_Bidiag_UT_create_T( A2, &T, NULL ); \ - FLA_Set( FLA_ZERO, T ); \ - FLA_Part_1x2( T, &TL, &TR, FLA_Obj_length( t ), FLA_LEFT ); \ - FLA_Accum_T_UT( FLA_FORWARD, FLA_COLUMNWISE, Ah, t, TL ); \ - } else {/*( *vect == 'P' ) V */ \ - FLA_Part_1x2( ATL, &A1, &A2, ( uplo == FLA_UPPER_TRIANGULAR ), FLA_LEFT ); \ - FLA_Merge_1x2( A2, ATR, &Ah ); \ - FLA_Merge_1x2( ATL, ATR, &A2 ); \ - FLA_Part_2x1( t, &t, \ - &T, FLA_Obj_min_dim( Ah ), FLA_TOP ); \ - \ - FLA_Bidiag_UT_create_T( A2, NULL, &T ); \ - FLA_Set( FLA_ZERO, T ); \ - FLA_Part_1x2( T, &TL, &TR, FLA_Obj_length( t ), FLA_LEFT ); \ - FLA_Accum_T_UT( FLA_FORWARD, FLA_ROWWISE, Ah, t, TL ); \ - } \ - if ( m_t > 0 ) { \ - PREFIX2FLAME_INVERT_TAU(prefix,t); \ - } \ - \ - /* Form Q or P^T ( U or V ) */ \ - if ( FLA_Obj_is_complex( A ) == TRUE && m_t > 0 ) { \ - FLA_Obj d2, e2, rL, rR; \ - \ - /* Temporary vectors to store diagonal and subdiagonal */ \ - FLA_Obj_create( datatype, m_t, 1, 0, 0, &d2 ); \ - if ( m_t > 1 ) FLA_Obj_create( datatype, m_t - 1, 1, 0, 0, &e2 ); \ - \ - /* Temporary vectors to store realifying transformation */ \ - FLA_Obj_create( datatype, m_t, 1, 0, 0, &rL ); \ - FLA_Obj_create( datatype, m_t, 1, 0, 0, &rR ); \ - \ - /* Extract diagonals (complex) and realify them. */ \ - /* This is tricky as the shape of A is explicitly */ \ - /* assumed by m, n, k. */ \ - if ( uplo == FLA_UPPER_TRIANGULAR ) \ - FLA_Bidiag_UT_u_extract_diagonals( A2, d2, e2 ); \ - else \ - FLA_Bidiag_UT_l_extract_diagonals( A2, d2, e2 ); \ - FLA_Bidiag_UT_realify_diagonals( uplo, d2, e2, rL, rR ); \ - \ - if ( *vect == 'Q' ) { \ - /* Overwrite A to compute Q */ \ - FLA_Bidiag_UT_form_U_ext( uplo, A, T, FLA_NO_TRANSPOSE, A ); \ - \ - /* Applying rL */ \ - FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, A2 ); \ - } else {/*( *vect == 'P' ) */ \ - /* Overwrite A to compute P */ \ - FLA_Bidiag_UT_form_V_ext( uplo, A, T, FLA_CONJ_TRANSPOSE, A ); \ - \ - /* Applying rR */ \ - FLA_Apply_diag_matrix( FLA_LEFT, FLA_CONJUGATE, rR, A2 ); \ - } \ - \ - /* Clean up */ \ - FLA_Obj_free( &rR ); \ - FLA_Obj_free( &rL ); \ - if ( m_t > 1 ) FLA_Obj_free( &e2 ); \ - FLA_Obj_free( &d2 ); \ - } else { \ - if ( *vect == 'Q' ) { \ - FLA_Bidiag_UT_form_U_ext( uplo, A, T, FLA_NO_TRANSPOSE, A ); \ - } else {/*( *vect == 'P' ) */ \ - FLA_Bidiag_UT_form_V_ext( uplo, A, T, FLA_CONJ_TRANSPOSE, A ); \ - } \ - } \ - \ - FLA_Obj_free( &T ); \ - FLA_Obj_free_without_buffer( &t ); \ - FLA_Obj_free_without_buffer( &A ); \ - \ - FLA_Finalize_safe( init_result ); \ - \ - *info = 0; \ - - +#define LAPACK_orgbr_body(prefix) \ + FLA_Datatype datatype = PREFIX2FLAME_DATATYPE(prefix); \ + FLA_Obj A, ATL, ATR, ABL, ABR, A1, A2, Ah, T, TL, TR, t; \ + FLA_Error init_result; \ + FLA_Uplo uplo; \ + dim_t m_A, n_A, m_t; \ + \ + FLA_Init_safe(&init_result); \ + \ + m_A = *m; \ + n_A = *n; \ + \ + /* A is assumed to m x k for 'Q' and k x n for 'Q'. */ \ + if (*vect == 'Q') \ + { \ + uplo = (*m >= *k ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR); \ + m_t = fla_min(*m, *k); \ + } \ + else \ + { /*( *vect == 'P' ) */ \ + uplo = (*k >= *n ? FLA_UPPER_TRIANGULAR : FLA_LOWER_TRIANGULAR); \ + m_t = fla_min(*k, *n); \ + } \ + \ + FLA_Obj_create_without_buffer(datatype, m_A, n_A, &A); \ + FLA_Obj_attach_buffer(buff_A, 1, *ldim_A, &A); \ + \ + FLA_Obj_create_without_buffer(datatype, m_t, 1, &t); \ + if (m_t > 0) \ + { \ + FLA_Obj_attach_buffer(buff_t, 1, m_t, &t); \ + PREFIX2FLAME_INVERT_TAU(prefix, t); \ + } \ + \ + FLA_Part_2x2(A, &ATL, &ATR, \ + &ABL, &ABR, m_t, m_t, FLA_TL); \ + \ + /* Accumulate house-holder vectors */ \ + if (*vect == 'Q') \ + { /* U */ \ + FLA_Part_2x1(ATL, &A1, \ + &A2, (uplo == FLA_LOWER_TRIANGULAR), FLA_TOP); \ + FLA_Merge_2x1(A2, \ + ABL, &Ah); \ + FLA_Merge_2x1(ATL, \ + ABL, &A2); \ + FLA_Part_2x1(t, &t, \ + &T, FLA_Obj_min_dim(Ah), FLA_TOP); \ + \ + FLA_Bidiag_UT_create_T(A2, &T, NULL); \ + FLA_Set(FLA_ZERO, T); \ + FLA_Part_1x2(T, &TL, &TR, FLA_Obj_length(t), FLA_LEFT); \ + FLA_Accum_T_UT(FLA_FORWARD, FLA_COLUMNWISE, Ah, t, TL); \ + } \ + else \ + { /*( *vect == 'P' ) V */ \ + FLA_Part_1x2(ATL, &A1, &A2, (uplo == FLA_UPPER_TRIANGULAR), FLA_LEFT); \ + FLA_Merge_1x2(A2, ATR, &Ah); \ + FLA_Merge_1x2(ATL, ATR, &A2); \ + FLA_Part_2x1(t, &t, \ + &T, FLA_Obj_min_dim(Ah), FLA_TOP); \ + \ + FLA_Bidiag_UT_create_T(A2, NULL, &T); \ + FLA_Set(FLA_ZERO, T); \ + FLA_Part_1x2(T, &TL, &TR, FLA_Obj_length(t), FLA_LEFT); \ + FLA_Accum_T_UT(FLA_FORWARD, FLA_ROWWISE, Ah, t, TL); \ + } \ + if (m_t > 0) \ + { \ + PREFIX2FLAME_INVERT_TAU(prefix, t); \ + } \ + \ + /* Form Q or P^T ( U or V ) */ \ + if (FLA_Obj_is_complex(A) == TRUE && m_t > 0) \ + { \ + FLA_Obj d2, e2, rL, rR; \ + \ + /* Temporary vectors to store diagonal and subdiagonal */ \ + FLA_Obj_create(datatype, m_t, 1, 0, 0, &d2); \ + if (m_t > 1) \ + FLA_Obj_create(datatype, m_t - 1, 1, 0, 0, &e2); \ + else \ + { \ + /* Creating object and freeing it to get rid of compiler warning */ \ + FLA_Obj_create(datatype, 1, 1, 0, 0, &e2); \ + FLA_Obj_free(&e2); \ + } \ + \ + /* Temporary vectors to store realifying transformation */ \ + FLA_Obj_create(datatype, m_t, 1, 0, 0, &rL); \ + FLA_Obj_create(datatype, m_t, 1, 0, 0, &rR); \ + \ + /* Extract diagonals (complex) and realify them. */ \ + /* This is tricky as the shape of A is explicitly */ \ + /* assumed by m, n, k. */ \ + if (uplo == FLA_UPPER_TRIANGULAR) \ + FLA_Bidiag_UT_u_extract_diagonals(A2, d2, e2); \ + else \ + FLA_Bidiag_UT_l_extract_diagonals(A2, d2, e2); \ + FLA_Bidiag_UT_realify_diagonals(uplo, d2, e2, rL, rR); \ + \ + if (*vect == 'Q') \ + { \ + /* Overwrite A to compute Q */ \ + FLA_Bidiag_UT_form_U_ext(uplo, A, T, FLA_NO_TRANSPOSE, A); \ + \ + /* Applying rL */ \ + FLA_Apply_diag_matrix(FLA_RIGHT, FLA_CONJUGATE, rL, A2); \ + } \ + else \ + { /*( *vect == 'P' ) */ \ + /* Overwrite A to compute P */ \ + FLA_Bidiag_UT_form_V_ext(uplo, A, T, FLA_CONJ_TRANSPOSE, A); \ + \ + /* Applying rR */ \ + FLA_Apply_diag_matrix(FLA_LEFT, FLA_CONJUGATE, rR, A2); \ + } \ + \ + /* Clean up */ \ + FLA_Obj_free(&rR); \ + FLA_Obj_free(&rL); \ + if (m_t > 1) \ + FLA_Obj_free(&e2); \ + FLA_Obj_free(&d2); \ + } \ + else \ + { \ + if (*vect == 'Q') \ + { \ + FLA_Bidiag_UT_form_U_ext(uplo, A, T, FLA_NO_TRANSPOSE, A); \ + } \ + else \ + { /*( *vect == 'P' ) */ \ + FLA_Bidiag_UT_form_V_ext(uplo, A, T, FLA_CONJ_TRANSPOSE, A); \ + } \ + } \ + \ + FLA_Obj_free(&T); \ + FLA_Obj_free_without_buffer(&t); \ + FLA_Obj_free_without_buffer(&A); \ + \ + FLA_Finalize_safe(init_result); \ + \ + *info = 0; LAPACK_orgbr(s, org) { int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sorgbr inputs: vect %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *vect, *m, *n, *k, *ldim_A); - { - LAPACK_RETURN_CHECK_VAR1(sorgbr_check(vect, - m, n, k, - buff_A, ldim_A, - buff_t, - buff_w, lwork, - info), fla_error) - } - if(fla_error==LAPACK_SUCCESS) - { + { + LAPACK_RETURN_CHECK_VAR1(sorgbr_check(vect, + m, n, k, + buff_A, ldim_A, + buff_t, + buff_w, lwork, + info), + fla_error) + } + if (fla_error == LAPACK_SUCCESS) + { LAPACK_orgbr_body(s) - /** fla_error set to 0 on LAPACK_SUCCESS */ + /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; - } - AOCL_DTL_TRACE_LOG_EXIT - return fla_error; + } + AOCL_DTL_TRACE_LOG_EXIT + return fla_error; } LAPACK_orgbr(d, org) { @@ -196,17 +221,18 @@ LAPACK_orgbr(d, org) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dorgbr inputs: vect %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *vect, *m, *n, *k, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1(dorgbr_check(vect, - m, n, k, - buff_A, ldim_A, - buff_t, - buff_w, lwork, - info),fla_error) + LAPACK_RETURN_CHECK_VAR1(dorgbr_check(vect, + m, n, k, + buff_A, ldim_A, + buff_t, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_orgbr_body(d) - /** fla_error set to 0 on LAPACK_SUCCESS */ + /** fla_error set to 0 on LAPACK_SUCCESS */ fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT @@ -219,18 +245,19 @@ LAPACK_orgbr(c, ung) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cungbr inputs: vect %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *vect, *m, *n, *k, *ldim_A); { - LAPACK_RETURN_CHECK_VAR1(cungbr_check(vect, - m, n, k, - buff_A, ldim_A, - buff_t, - buff_w, lwork, - info),fla_error) + LAPACK_RETURN_CHECK_VAR1(cungbr_check(vect, + m, n, k, + buff_A, ldim_A, + buff_t, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { LAPACK_orgbr_body(c) - /** fla_error set to 0 on LAPACK_SUCCESS */ - fla_error = 0; + /** fla_error set to 0 on LAPACK_SUCCESS */ + fla_error = 0; } AOCL_DTL_TRACE_LOG_EXIT return fla_error; @@ -242,11 +269,12 @@ LAPACK_orgbr(z, ung) AOCL_DTL_SNPRINTF("zungbr inputs: vect %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *vect, *m, *n, *k, *ldim_A); { LAPACK_RETURN_CHECK_VAR1(zungbr_check(vect, - m, n, k, - buff_A, ldim_A, - buff_t, - buff_w, lwork, - info), fla_error) + m, n, k, + buff_A, ldim_A, + buff_t, + buff_w, lwork, + info), + fla_error) } if (fla_error == LAPACK_SUCCESS) { diff --git a/src/map/lapack2flamec/FLA_orglq.c b/src/map/lapack2flamec/FLA_orglq.c index d23a25948..a5204792d 100644 --- a/src/map/lapack2flamec/FLA_orglq.c +++ b/src/map/lapack2flamec/FLA_orglq.c @@ -83,7 +83,7 @@ LAPACK_orglq(s, org) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sorglq inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sorglq_check( m, n, k, @@ -116,7 +116,7 @@ LAPACK_orglq(d, org) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dorglq inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dorglq_check( m, n, k, diff --git a/src/map/lapack2flamec/FLA_orgqr.c b/src/map/lapack2flamec/FLA_orgqr.c index fc22ea469..3531ccb16 100644 --- a/src/map/lapack2flamec/FLA_orgqr.c +++ b/src/map/lapack2flamec/FLA_orgqr.c @@ -28,6 +28,7 @@ extern int lapack_dorgqr(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, integer *info); extern int sorgqr_fla(integer *m, integer *n, integer *k, real * a, integer *lda, real *tau, real *work, integer *lwork, integer *info); +extern int dorg2r_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *info); #define LAPACK_orgqr(prefix, name) \ int F77_ ## prefix ## name ## qr( integer* m, \ @@ -81,7 +82,7 @@ LAPACK_orgqr(s, org) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sorgqr inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(sorgqr_check(m, n, k, @@ -114,7 +115,7 @@ LAPACK_orgqr(d, org) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dorgqr inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dorgqr_check( m, n, k, @@ -205,7 +206,7 @@ LAPACK_org2r(s, org) AOCL_DTL_SNPRINTF("sorg2r inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); extern int sorg2r_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *work, integer *info); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sorg2r_check( m, n, k, @@ -222,7 +223,7 @@ LAPACK_org2r(s, org) } AOCL_DTL_TRACE_LOG_EXIT return fla_error; -#else +#else { sorg2r_fla( m, n, k, buff_A, ldim_A, @@ -237,9 +238,11 @@ LAPACK_org2r(s, org) LAPACK_org2r(d, org) { - int fla_error = LAPACK_SUCCESS; AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dorg2r inputs: m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS "", *m, *n, *k, *ldim_A); + +#if !FLA_ENABLE_AMD_OPT + int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dorg2r_check( m, n, k, buff_A, ldim_A, @@ -255,6 +258,17 @@ LAPACK_org2r(d, org) } AOCL_DTL_TRACE_LOG_EXIT return fla_error; +#else + { + dorg2r_fla( m, n, k, + buff_A, ldim_A, + buff_t, + buff_w, + info ); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif } #ifdef FLA_LAPACK2FLAME_SUPPORT_COMPLEX diff --git a/src/map/lapack2flamec/FLA_orgtr.c b/src/map/lapack2flamec/FLA_orgtr.c index 82e99b3fa..c2a75dd67 100644 --- a/src/map/lapack2flamec/FLA_orgtr.c +++ b/src/map/lapack2flamec/FLA_orgtr.c @@ -159,10 +159,10 @@ LAPACK_orgtr(d, org) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dorgtr inputs: uplo %c, n %" FLA_IS ", lda %" FLA_IS "", *uplo, *m, *ldim_A); { - #if !FLA_AMD_OPT + #if !FLA_ENABLE_AMD_OPT if ( *uplo == 'U' || *uplo == 'u' ) #endif - { + { dorgtr_fla( uplo, m, buff_A, ldim_A, buff_t, diff --git a/src/map/lapack2flamec/FLA_ormbr.c b/src/map/lapack2flamec/FLA_ormbr.c index 2db997d43..7b34c8111 100644 --- a/src/map/lapack2flamec/FLA_ormbr.c +++ b/src/map/lapack2flamec/FLA_ormbr.c @@ -227,7 +227,7 @@ LAPACK_ormbr(s, orm) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sormbr inputs: vect %c, side %c, trans %c, m " FLA_IS ", n " FLA_IS ", k " FLA_IS ", lda " FLA_IS ", ldc " FLA_IS "", *vect, *side, *trans, *m, *n, *k, *ldim_A, *ldim_C); { -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(sormbr_check(vect, side, trans, @@ -266,7 +266,7 @@ LAPACK_ormbr(d, orm) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormbr inputs: vect %c, side %c, trans %c, m " FLA_IS ", n " FLA_IS ", k " FLA_IS ", lda " FLA_IS ", ldc " FLA_IS "", *vect, *side, *trans, *m, *n, *k, *ldim_A, *ldim_C); { -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(dormbr_check(vect, side, trans, diff --git a/src/map/lapack2flamec/FLA_ormlq.c b/src/map/lapack2flamec/FLA_ormlq.c index b5268b563..8000c9964 100644 --- a/src/map/lapack2flamec/FLA_ormlq.c +++ b/src/map/lapack2flamec/FLA_ormlq.c @@ -99,7 +99,7 @@ LAPACK_ormlq(s, orm) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sormlq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sormlq_check( side, trans, @@ -136,7 +136,7 @@ LAPACK_ormlq(d, orm) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormlq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1(dormlq_check(side, trans, diff --git a/src/map/lapack2flamec/FLA_ormqr.c b/src/map/lapack2flamec/FLA_ormqr.c index ab8aaaa11..b765a8cf5 100644 --- a/src/map/lapack2flamec/FLA_ormqr.c +++ b/src/map/lapack2flamec/FLA_ormqr.c @@ -100,7 +100,7 @@ LAPACK_ormqr(s, orm) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sormqr inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sormqr_check( side, trans, @@ -135,7 +135,7 @@ LAPACK_ormqr(d, orm) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormqr inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dormqr_check( side, trans, @@ -234,7 +234,7 @@ LAPACK_orm2r(s, orm) AOCL_DTL_SNPRINTF("sorm2r inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); extern int sorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *info); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( sorm2r_check( side, trans, @@ -274,7 +274,7 @@ LAPACK_orm2r(d, orm) AOCL_DTL_SNPRINTF("dorm2r inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "", *side, *trans, *m, *n, *k, *ldim_A, *ldim_B); extern int dorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal * c__, integer *ldc, doublereal *work, integer *info); -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT int fla_error = LAPACK_SUCCESS; { LAPACK_RETURN_CHECK_VAR1( dorm2r_check( side, trans, diff --git a/src/map/lapack2flamec/FLA_ormtr.c b/src/map/lapack2flamec/FLA_ormtr.c index cca0081dd..7b296086e 100644 --- a/src/map/lapack2flamec/FLA_ormtr.c +++ b/src/map/lapack2flamec/FLA_ormtr.c @@ -203,7 +203,7 @@ LAPACK_ormtr(d, orm) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormtr inputs: side %c, uplo %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "\n", *side, *uplo, *trans, *m, *n, *ldim_A, *ldim_C); { -#if !FLA_AMD_OPT +#if !FLA_ENABLE_AMD_OPT if (*uplo == 'U' || *uplo == 'u') #endif { diff --git a/src/map/lapack2flamec/FLA_potrf.c b/src/map/lapack2flamec/FLA_potrf.c index 3331131f4..b0bcae7f7 100644 --- a/src/map/lapack2flamec/FLA_potrf.c +++ b/src/map/lapack2flamec/FLA_potrf.c @@ -31,6 +31,19 @@ completed. */ +extern int spotrf_check(char *uplo, integer *n, float *a, integer *lda, integer *info); +extern int dpotrf_check(char *uplo, integer *n, double *a, integer * lda, integer *info); +extern int cpotrf_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *info); +extern int zpotrf_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *info); +extern int lapack_spotrf(char *uplo, integer *n, float *a, integer *lda, integer *info); +extern int lapack_dpotrf(char *uplo, integer *n, double *a, integer *lda, integer *info); +extern int spotf2_check(char *uplo, integer *n, float *a, integer *lda, integer *info); +extern int dpotf2_check(char *uplo, integer *n, double *a, integer * lda, integer *info); +extern int cpotf2_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *info); +extern int zpotf2_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *info); +extern int lapack_spotf2(char *uplo, integer *n, float *a, integer *lda, integer *info); +extern int lapack_dpotf2(char *uplo, integer *n, double *a, integer *lda, integer *info); + extern void DTL_Trace( uint8 ui8LogLevel, uint8 ui8LogType, @@ -47,7 +60,7 @@ extern void DTL_Trace( integer* ldim_A, \ integer* info ) -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT #define LAPACK_potrf_body_s(prefix) \ if( *n < FLA_POTRF_FLOAT_SMALL ) \ lapack_spotf2( uplo, n, buff_A, ldim_A, info ); \ @@ -98,7 +111,7 @@ LAPACK_potrf(s) } if (fla_error == LAPACK_SUCCESS) { -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { LAPACK_potrf_body_s(s); } @@ -126,7 +139,7 @@ LAPACK_potrf(d) } if (fla_error == LAPACK_SUCCESS) { -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { LAPACK_potrf_body_d(d) } @@ -200,7 +213,7 @@ LAPACK_potf2(s) } if (fla_error == LAPACK_SUCCESS) { -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { LAPACK_potrf_body_s(s) } @@ -227,7 +240,7 @@ LAPACK_potf2(d) } if (fla_error == LAPACK_SUCCESS) { -#if FLA_AMD_OPT +#if FLA_ENABLE_AMD_OPT { LAPACK_potrf_body_d(d) } diff --git a/src/map/lapack2flamec/FLA_spffrt2.c b/src/map/lapack2flamec/FLA_spffrt2.c index ec1d0f280..8de211940 100644 --- a/src/map/lapack2flamec/FLA_spffrt2.c +++ b/src/map/lapack2flamec/FLA_spffrt2.c @@ -16,6 +16,15 @@ symmetric matrix in packed storage format. */ +extern int sspffrt2_check(float *ap, integer *n, integer * ncolm, float *work, float *work2); +extern int dspffrt2_check(double *ap, integer *n, integer * ncolm, double *work, double *work2); +extern int cspffrt2_check(scomplex *ap, integer *n, integer * ncolm, scomplex *work, scomplex *work2); +extern int zspffrt2_check(dcomplex *ap, integer *n, integer * ncolm, dcomplex *work, dcomplex *work2); +extern void sspffrt2_fla(float *ap, integer *n, integer * ncolm, float *work, float *work2); +extern void dspffrt2_fla(double *ap, integer *n, integer * ncolm, double *work, double *work2); +extern void cspffrt2_fla(scomplex *ap, integer *n, integer * ncolm, scomplex *work, scomplex *work2); +extern void zspffrt2_fla(dcomplex *ap, integer *n, integer * ncolm, dcomplex *work, dcomplex *work2); + #define LAPACK_spffrt2(prefix) \ int F77_ ## prefix ## spffrt2( PREFIX2LAPACK_TYPEDEF(prefix)* buff_AP, \ integer* n, \ diff --git a/src/map/lapack2flamec/FLA_spffrtx.c b/src/map/lapack2flamec/FLA_spffrtx.c index dd4aa866d..fad41f503 100644 --- a/src/map/lapack2flamec/FLA_spffrtx.c +++ b/src/map/lapack2flamec/FLA_spffrtx.c @@ -16,6 +16,15 @@ symmetric matrix in packed storage format. */ +extern void sspffrtx_fla(float *ap, integer *n, integer * ncolm, float *work, float *work2); +extern void dspffrtx_fla(double *ap, integer *n, integer * ncolm, double *work, double *work2); +extern void cspffrtx_fla(scomplex *ap, integer *n, integer * ncolm, scomplex *work, scomplex *work2); +extern void zspffrtx_fla(dcomplex *ap, integer *n, integer * ncolm, dcomplex *work, dcomplex *work2); +extern int sspffrtx_check(float *ap, integer *n, integer * ncolm, float *work, float *work2); +extern int dspffrtx_check(double *ap, integer *n, integer * ncolm, double *work, double *work2); +extern int cspffrtx_check(scomplex *ap, integer *n, integer * ncolm, scomplex *work, scomplex *work2); +extern int zspffrtx_check(dcomplex *ap, integer *n, integer * ncolm, dcomplex *work, dcomplex *work2); + #define LAPACK_spffrtx(prefix) \ int F77_ ## prefix ## spffrtx( PREFIX2LAPACK_TYPEDEF(prefix)* buff_AP, \ integer* n, \ diff --git a/src/map/lapack2flamec/check/cbdsqr_check.c b/src/map/lapack2flamec/check/cbdsqr_check.c index 6f69aa263..e111fb8a3 100644 --- a/src/map/lapack2flamec/check/cbdsqr_check.c +++ b/src/map/lapack2flamec/check/cbdsqr_check.c @@ -28,8 +28,8 @@ int cbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * --rwork; /* Function Body */ *info = 0; - lower = lsame_(uplo, "L"); - if (! lsame_(uplo, "U") && ! lower) + lower = lsame_(uplo, "L", 1, 1); + if (! lsame_(uplo, "U", 1, 1) && ! lower) { *info = -1; } @@ -64,7 +64,7 @@ int cbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CBDSQR", &i__1); + xerbla_("CBDSQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*n == 0) diff --git a/src/map/lapack2flamec/check/cgebd2_check.c b/src/map/lapack2flamec/check/cgebd2_check.c index 2548c8750..525b39b0a 100644 --- a/src/map/lapack2flamec/check/cgebd2_check.c +++ b/src/map/lapack2flamec/check/cgebd2_check.c @@ -32,7 +32,7 @@ int cgebd2_check(integer *m, integer *n, scomplex *a, integer *lda, real *d__, r if (*info < 0) { i__1 = -(*info); - xerbla_("CGEBD2", &i__1); + xerbla_("CGEBD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/cgebrd_check.c b/src/map/lapack2flamec/check/cgebrd_check.c index f8e0e9a6f..2014960c7 100644 --- a/src/map/lapack2flamec/check/cgebrd_check.c +++ b/src/map/lapack2flamec/check/cgebrd_check.c @@ -60,7 +60,7 @@ int cgebrd_check(integer *m, integer *n, scomplex *a, integer *lda, real *d__, r if (*info < 0) { i__1 = -(*info); - xerbla_("CGEBRD", &i__1); + xerbla_("CGEBRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgehd2_check.c b/src/map/lapack2flamec/check/cgehd2_check.c index a041e3b2a..5816399f2 100644 --- a/src/map/lapack2flamec/check/cgehd2_check.c +++ b/src/map/lapack2flamec/check/cgehd2_check.c @@ -33,7 +33,7 @@ int cgehd2_check(integer *n, integer *ilo, integer *ihi, scomplex * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CGEHD2", &i__1); + xerbla_("CGEHD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/cgehrd_check.c b/src/map/lapack2flamec/check/cgehrd_check.c index df0b3b697..41eb5514f 100644 --- a/src/map/lapack2flamec/check/cgehrd_check.c +++ b/src/map/lapack2flamec/check/cgehrd_check.c @@ -53,7 +53,7 @@ int cgehrd_check(integer *n, integer *ilo, integer *ihi, scomplex * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CGEHRD", &i__1); + xerbla_("CGEHRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgelq2_check.c b/src/map/lapack2flamec/check/cgelq2_check.c index bbfb58676..7c19bc8b4 100644 --- a/src/map/lapack2flamec/check/cgelq2_check.c +++ b/src/map/lapack2flamec/check/cgelq2_check.c @@ -27,7 +27,7 @@ int cgelq2_check(integer *m, integer *n, scomplex *a, integer *lda, scomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQ2", &i__1); + xerbla_("CGELQ2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } diff --git a/src/map/lapack2flamec/check/cgelqf_check.c b/src/map/lapack2flamec/check/cgelqf_check.c index b9e75e807..84e1c853e 100644 --- a/src/map/lapack2flamec/check/cgelqf_check.c +++ b/src/map/lapack2flamec/check/cgelqf_check.c @@ -44,7 +44,7 @@ int cgelqf_check(integer *m, integer *n, scomplex *a, integer *lda, scomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQF", &i__1); + xerbla_("CGELQF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgelsd_check.c b/src/map/lapack2flamec/check/cgelsd_check.c index 61cc2b70c..716c76597 100644 --- a/src/map/lapack2flamec/check/cgelsd_check.c +++ b/src/map/lapack2flamec/check/cgelsd_check.c @@ -212,7 +212,7 @@ int cgelsd_check(integer *m, integer *n, integer *nrhs, scomplex * a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSD", &i__1); + xerbla_("CGELSD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgeqp3_check.c b/src/map/lapack2flamec/check/cgeqp3_check.c index 680ea380c..33ec7bd26 100644 --- a/src/map/lapack2flamec/check/cgeqp3_check.c +++ b/src/map/lapack2flamec/check/cgeqp3_check.c @@ -59,7 +59,7 @@ int cgeqp3_check(integer *m, integer *n, scomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQP3", &i__1); + xerbla_("CGEQP3", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgeqpf_check.c b/src/map/lapack2flamec/check/cgeqpf_check.c index 7aa92e010..5fc4510d2 100644 --- a/src/map/lapack2flamec/check/cgeqpf_check.c +++ b/src/map/lapack2flamec/check/cgeqpf_check.c @@ -30,7 +30,7 @@ int cgeqpf_check(integer *m, integer *n, scomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQPF", &i__1); + xerbla_("CGEQPF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cgeqr2_check.c b/src/map/lapack2flamec/check/cgeqr2_check.c index 2e3a92e0c..870ef916f 100644 --- a/src/map/lapack2flamec/check/cgeqr2_check.c +++ b/src/map/lapack2flamec/check/cgeqr2_check.c @@ -27,7 +27,7 @@ int cgeqr2_check(integer *m, integer *n, scomplex *a, integer *lda, scomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQR2", &i__1); + xerbla_("CGEQR2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cgeqr2p_check.c b/src/map/lapack2flamec/check/cgeqr2p_check.c index e30632326..6447fe152 100644 --- a/src/map/lapack2flamec/check/cgeqr2p_check.c +++ b/src/map/lapack2flamec/check/cgeqr2p_check.c @@ -27,7 +27,7 @@ int cgeqr2p_check(integer *m, integer *n, scomplex *a, integer * lda, scomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQR2P", &i__1); + xerbla_("CGEQR2P", &i__1, (ftnlen)7); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/cgeqrf_check.c b/src/map/lapack2flamec/check/cgeqrf_check.c index 960db0fc1..6c0d2c5c7 100644 --- a/src/map/lapack2flamec/check/cgeqrf_check.c +++ b/src/map/lapack2flamec/check/cgeqrf_check.c @@ -41,7 +41,7 @@ int cgeqrf_check(integer *m, integer *n, scomplex *a, integer *lda, scomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRF", &i__1); + xerbla_("CGEQRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgeqrfp_check.c b/src/map/lapack2flamec/check/cgeqrfp_check.c index 6b1e58852..5ccfe19bb 100644 --- a/src/map/lapack2flamec/check/cgeqrfp_check.c +++ b/src/map/lapack2flamec/check/cgeqrfp_check.c @@ -44,7 +44,7 @@ int cgeqrfp_check(integer *m, integer *n, scomplex *a, integer * lda, scomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRFP", &i__1); + xerbla_("CGEQRFP", &i__1, (ftnlen)7); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgesdd_check.c b/src/map/lapack2flamec/check/cgesdd_check.c index ed26b9722..6793fe004 100644 --- a/src/map/lapack2flamec/check/cgesdd_check.c +++ b/src/map/lapack2flamec/check/cgesdd_check.c @@ -34,11 +34,11 @@ int cgesdd_check(char *jobz, integer *m, integer *n, scomplex *a, integer *lda, minmn = fla_min(*m,*n); mnthr1 = (integer) (minmn * 17.f / 9.f); mnthr2 = (integer) (minmn * 5.f / 3.f); - wntqa = lsame_(jobz, "A"); - wntqs = lsame_(jobz, "S"); + wntqa = lsame_(jobz, "A", 1, 1); + wntqs = lsame_(jobz, "S", 1, 1); wntqas = wntqa || wntqs; - wntqo = lsame_(jobz, "O"); - wntqn = lsame_(jobz, "N"); + wntqo = lsame_(jobz, "O", 1, 1); + wntqn = lsame_(jobz, "N", 1, 1); minwrk = 1; maxwrk = 1; if (! (wntqa || wntqs || wntqo || wntqn)) @@ -437,7 +437,7 @@ int cgesdd_check(char *jobz, integer *m, integer *n, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CGESDD", &i__1); + xerbla_("CGESDD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*lwork == -1) diff --git a/src/map/lapack2flamec/check/cgesvd_check.c b/src/map/lapack2flamec/check/cgesvd_check.c index ab98a54d7..9429db907 100644 --- a/src/map/lapack2flamec/check/cgesvd_check.c +++ b/src/map/lapack2flamec/check/cgesvd_check.c @@ -41,16 +41,16 @@ int cgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, scomplex *a, i /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if (! (wntua || wntus || wntuo || wntun)) { @@ -615,7 +615,7 @@ int cgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, scomplex *a, i if (*info != 0) { i__2 = -(*info); - xerbla_("CGESVD", &i__2); + xerbla_("CGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cgetf2_check.c b/src/map/lapack2flamec/check/cgetf2_check.c index 37340565b..52277a7f2 100644 --- a/src/map/lapack2flamec/check/cgetf2_check.c +++ b/src/map/lapack2flamec/check/cgetf2_check.c @@ -26,7 +26,7 @@ int cgetf2_check(integer *m, integer *n, scomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("CGETF2", &i__1); + xerbla_("CGETF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cgetrf_check.c b/src/map/lapack2flamec/check/cgetrf_check.c index d729d3bbb..0f7102821 100644 --- a/src/map/lapack2flamec/check/cgetrf_check.c +++ b/src/map/lapack2flamec/check/cgetrf_check.c @@ -27,7 +27,7 @@ int cgetrf_check(integer *m, integer *n, scomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRF", &i__1); + xerbla_("CGETRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cgetrfnp_check.c b/src/map/lapack2flamec/check/cgetrfnp_check.c index 1388c9139..1357075e3 100644 --- a/src/map/lapack2flamec/check/cgetrfnp_check.c +++ b/src/map/lapack2flamec/check/cgetrfnp_check.c @@ -30,7 +30,7 @@ int cgetrfnp_check(integer *m, integer *n, scomplex *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRFNP", &i__1); + xerbla_("CGETRFNP", &i__1, (ftnlen)8); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cgetrfnpi_check.c b/src/map/lapack2flamec/check/cgetrfnpi_check.c index 818cf1b84..5f5340f92 100644 --- a/src/map/lapack2flamec/check/cgetrfnpi_check.c +++ b/src/map/lapack2flamec/check/cgetrfnpi_check.c @@ -34,7 +34,7 @@ int cgetrfnpi_check(integer *m, integer *n, integer *nfact, scomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRFNPI", &i__1); + xerbla_("CGETRFNPI", &i__1, (ftnlen)9); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/chegs2_check.c b/src/map/lapack2flamec/check/chegs2_check.c index 2bb36706d..8f2d0f8ae 100644 --- a/src/map/lapack2flamec/check/chegs2_check.c +++ b/src/map/lapack2flamec/check/chegs2_check.c @@ -16,12 +16,12 @@ int chegs2_check(integer *itype, char *uplo, integer *n, scomplex * a, integer * b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -40,7 +40,7 @@ int chegs2_check(integer *itype, char *uplo, integer *n, scomplex * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGS2", &i__1); + xerbla_("CHEGS2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/chegst_check.c b/src/map/lapack2flamec/check/chegst_check.c index c7b30272b..0c964aff2 100644 --- a/src/map/lapack2flamec/check/chegst_check.c +++ b/src/map/lapack2flamec/check/chegst_check.c @@ -17,12 +17,12 @@ int chegst_check(integer *itype, char *uplo, integer *n, scomplex * a, integer * b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -41,7 +41,7 @@ int chegst_check(integer *itype, char *uplo, integer *n, scomplex * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGST", &i__1); + xerbla_("CHEGST", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/chetd2_check.c b/src/map/lapack2flamec/check/chetd2_check.c index 4cc869539..4aee3fa09 100644 --- a/src/map/lapack2flamec/check/chetd2_check.c +++ b/src/map/lapack2flamec/check/chetd2_check.c @@ -17,8 +17,8 @@ int chetd2_check(char *uplo, integer *n, scomplex *a, integer *lda, float *d__, --tau; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -33,7 +33,7 @@ int chetd2_check(char *uplo, integer *n, scomplex *a, integer *lda, float *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETD2", &i__1); + xerbla_("CHETD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/chetrd_check.c b/src/map/lapack2flamec/check/chetrd_check.c index 7cfeda9ff..1ffc062f2 100644 --- a/src/map/lapack2flamec/check/chetrd_check.c +++ b/src/map/lapack2flamec/check/chetrd_check.c @@ -23,9 +23,9 @@ int chetrd_check(char *uplo, integer *n, scomplex *a, integer *lda, float *d__, --work; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; - if (! upper && ! lsame_(uplo, "L")) + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -52,7 +52,7 @@ int chetrd_check(char *uplo, integer *n, scomplex *a, integer *lda, float *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD", &i__1); + xerbla_("CHETRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/clauu2_check.c b/src/map/lapack2flamec/check/clauu2_check.c index e8d67e381..a216da36b 100644 --- a/src/map/lapack2flamec/check/clauu2_check.c +++ b/src/map/lapack2flamec/check/clauu2_check.c @@ -14,8 +14,8 @@ int clauu2_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int clauu2_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("CLAUU2", &i__1); + xerbla_("CLAUU2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/clauum_check.c b/src/map/lapack2flamec/check/clauum_check.c index 3bc40a49a..2b1c97112 100644 --- a/src/map/lapack2flamec/check/clauum_check.c +++ b/src/map/lapack2flamec/check/clauum_check.c @@ -14,8 +14,8 @@ int clauum_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int clauum_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("CLAUUM", &i__1); + xerbla_("CLAUUM", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cpotf2_check.c b/src/map/lapack2flamec/check/cpotf2_check.c index 356291372..e14631b37 100644 --- a/src/map/lapack2flamec/check/cpotf2_check.c +++ b/src/map/lapack2flamec/check/cpotf2_check.c @@ -14,8 +14,8 @@ int cpotf2_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int cpotf2_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("CPOTF2", &i__1); + xerbla_("CPOTF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cpotrf_check.c b/src/map/lapack2flamec/check/cpotrf_check.c index 90e27e66c..8a14b0b93 100644 --- a/src/map/lapack2flamec/check/cpotrf_check.c +++ b/src/map/lapack2flamec/check/cpotrf_check.c @@ -13,8 +13,8 @@ int cpotrf_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -29,7 +29,7 @@ int cpotrf_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("CPOTRF", &i__1); + xerbla_("CPOTRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cpotri_check.c b/src/map/lapack2flamec/check/cpotri_check.c index e1a7b7bce..968b76297 100644 --- a/src/map/lapack2flamec/check/cpotri_check.c +++ b/src/map/lapack2flamec/check/cpotri_check.c @@ -11,7 +11,7 @@ int cpotri_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -26,7 +26,7 @@ int cpotri_check(char *uplo, integer *n, scomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("CPOTRI", &i__1); + xerbla_("CPOTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/ctrti2_check.c b/src/map/lapack2flamec/check/ctrti2_check.c index c7aaf059c..645272360 100644 --- a/src/map/lapack2flamec/check/ctrti2_check.c +++ b/src/map/lapack2flamec/check/ctrti2_check.c @@ -15,13 +15,13 @@ int ctrti2_check(char *uplo, char *diag, integer *n, scomplex *a, integer *lda, a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -36,7 +36,7 @@ int ctrti2_check(char *uplo, char *diag, integer *n, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CTRTI2", &i__1); + xerbla_("CTRTI2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/ctrtri_check.c b/src/map/lapack2flamec/check/ctrtri_check.c index f2bd02a54..86364ca1c 100644 --- a/src/map/lapack2flamec/check/ctrtri_check.c +++ b/src/map/lapack2flamec/check/ctrtri_check.c @@ -15,13 +15,13 @@ int ctrtri_check(char *uplo, char *diag, integer *n, scomplex *a, integer *lda, a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -36,7 +36,7 @@ int ctrtri_check(char *uplo, char *diag, integer *n, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CTRTRI", &i__1); + xerbla_("CTRTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cung2r_check.c b/src/map/lapack2flamec/check/cung2r_check.c index 2b0c6f0b5..1719c2b8f 100644 --- a/src/map/lapack2flamec/check/cung2r_check.c +++ b/src/map/lapack2flamec/check/cung2r_check.c @@ -33,7 +33,7 @@ int cung2r_check(integer *m, integer *n, integer *k, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNG2R", &i__1); + xerbla_("CUNG2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cungbr_check.c b/src/map/lapack2flamec/check/cungbr_check.c index e33317bb9..b5b2f7490 100644 --- a/src/map/lapack2flamec/check/cungbr_check.c +++ b/src/map/lapack2flamec/check/cungbr_check.c @@ -26,10 +26,10 @@ int cungbr_check(char *vect, integer *m, integer *n, integer *k, scomplex *a, in --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "Q"); + wantq = lsame_(vect, "Q", 1, 1); mn = fla_min(*m,*n); lquery = *lwork == -1; - if (! wantq && ! lsame_(vect, "P")) + if (! wantq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } @@ -97,7 +97,7 @@ int cungbr_check(char *vect, integer *m, integer *n, integer *k, scomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGBR", &i__1); + xerbla_("CUNGBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cungl2_check.c b/src/map/lapack2flamec/check/cungl2_check.c index a7f023d54..f822fa2e5 100644 --- a/src/map/lapack2flamec/check/cungl2_check.c +++ b/src/map/lapack2flamec/check/cungl2_check.c @@ -33,7 +33,7 @@ int cungl2_check(integer *m, integer *n, integer *k, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGL2", &i__1); + xerbla_("CUNGL2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cunglq_check.c b/src/map/lapack2flamec/check/cunglq_check.c index 439eb42ea..2f7ab70f2 100644 --- a/src/map/lapack2flamec/check/cunglq_check.c +++ b/src/map/lapack2flamec/check/cunglq_check.c @@ -48,7 +48,7 @@ int cunglq_check(integer *m, integer *n, integer *k, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGLQ", &i__1); + xerbla_("CUNGLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cungqr_check.c b/src/map/lapack2flamec/check/cungqr_check.c index 20b3be378..e2b7e5500 100644 --- a/src/map/lapack2flamec/check/cungqr_check.c +++ b/src/map/lapack2flamec/check/cungqr_check.c @@ -48,7 +48,7 @@ int cungqr_check(integer *m, integer *n, integer *k, scomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGQR", &i__1); + xerbla_("CUNGQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cungtr_check.c b/src/map/lapack2flamec/check/cungtr_check.c index bbafbc6e2..efe3e43a9 100644 --- a/src/map/lapack2flamec/check/cungtr_check.c +++ b/src/map/lapack2flamec/check/cungtr_check.c @@ -22,8 +22,8 @@ int cungtr_check(char *uplo, integer *n, scomplex *a, integer *lda, scomplex *ta /* Function Body */ *info = 0; lquery = *lwork == -1; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -71,7 +71,7 @@ int cungtr_check(char *uplo, integer *n, scomplex *a, integer *lda, scomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGTR", &i__1); + xerbla_("CUNGTR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cunm2r_check.c b/src/map/lapack2flamec/check/cunm2r_check.c index 3a203a8f7..6153e83bc 100644 --- a/src/map/lapack2flamec/check/cunm2r_check.c +++ b/src/map/lapack2flamec/check/cunm2r_check.c @@ -22,8 +22,8 @@ int cunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, sc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -33,11 +33,11 @@ int cunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, sc { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -64,7 +64,7 @@ int cunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, sc if (*info != 0) { i__1 = -(*info); - xerbla_("CUNM2R", &i__1); + xerbla_("CUNM2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cunmbr_check.c b/src/map/lapack2flamec/check/cunmbr_check.c index 0b35ee4a8..b2ea45bfe 100644 --- a/src/map/lapack2flamec/check/cunmbr_check.c +++ b/src/map/lapack2flamec/check/cunmbr_check.c @@ -28,9 +28,9 @@ int cunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in --work; /* Function Body */ *info = 0; - applyq = lsame_(vect, "Q"); - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + applyq = lsame_(vect, "Q", 1, 1); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q or P and NW is the minimum dimension of WORK */ if (left) @@ -47,15 +47,15 @@ int cunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in { nw = 0; } - if (! applyq && ! lsame_(vect, "P")) + if (! applyq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } - else if (! left && ! lsame_(side, "R")) + else if (! left && ! lsame_(side, "R", 1, 1)) { *info = -2; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -3; } @@ -138,7 +138,7 @@ int cunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMBR", &i__1); + xerbla_("CUNMBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cunml2_check.c b/src/map/lapack2flamec/check/cunml2_check.c index 3a0cfc1f9..801044a1c 100644 --- a/src/map/lapack2flamec/check/cunml2_check.c +++ b/src/map/lapack2flamec/check/cunml2_check.c @@ -21,8 +21,8 @@ int cunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, sc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -32,11 +32,11 @@ int cunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, sc { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -63,7 +63,7 @@ int cunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, sc if (*info != 0) { i__1 = -(*info); - xerbla_("CUNML2", &i__1); + xerbla_("CUNML2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/cunmlq_check.c b/src/map/lapack2flamec/check/cunmlq_check.c index d4ed43742..cf536ad44 100644 --- a/src/map/lapack2flamec/check/cunmlq_check.c +++ b/src/map/lapack2flamec/check/cunmlq_check.c @@ -29,8 +29,8 @@ int cunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, sc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -43,11 +43,11 @@ int cunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, sc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -90,7 +90,7 @@ int cunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, sc if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMLQ", &i__1); + xerbla_("CUNMLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cunmqr_check.c b/src/map/lapack2flamec/check/cunmqr_check.c index 8d7346210..a3e36f82c 100644 --- a/src/map/lapack2flamec/check/cunmqr_check.c +++ b/src/map/lapack2flamec/check/cunmqr_check.c @@ -27,8 +27,8 @@ int cunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, sc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int cunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, sc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -88,7 +88,7 @@ int cunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, sc if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMQR", &i__1); + xerbla_("CUNMQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/cunmtr_check.c b/src/map/lapack2flamec/check/cunmtr_check.c index 08b323605..920161fc7 100644 --- a/src/map/lapack2flamec/check/cunmtr_check.c +++ b/src/map/lapack2flamec/check/cunmtr_check.c @@ -29,8 +29,8 @@ int cunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, sc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - upper = lsame_(uplo, "U"); + left = lsame_(side, "L", 1, 1); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -43,15 +43,15 @@ int cunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, sc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } - else if (! lsame_(trans, "N") && ! lsame_(trans, "C")) + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, "C", 1, 1)) { *info = -3; } @@ -114,7 +114,7 @@ int cunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, sc if (*info != 0) { i__2 = -(*info); - xerbla_("CUNMTR", &i__2); + xerbla_("CUNMTR", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dbdsqr_check.c b/src/map/lapack2flamec/check/dbdsqr_check.c index 24762fb1a..e1e9dd936 100644 --- a/src/map/lapack2flamec/check/dbdsqr_check.c +++ b/src/map/lapack2flamec/check/dbdsqr_check.c @@ -33,8 +33,8 @@ int dbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * --work; /* Function Body */ *info = 0; - lower = lsame_(uplo, "L"); - if (! lsame_(uplo, "U") && ! lower) + lower = lsame_(uplo, "L", 1, 1); + if (! lsame_(uplo, "U", 1, 1) && ! lower) { *info = -1; } @@ -69,7 +69,7 @@ int dbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DBDSQR", &i__1); + xerbla_("DBDSQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*n == 0) diff --git a/src/map/lapack2flamec/check/dgebd2_check.c b/src/map/lapack2flamec/check/dgebd2_check.c index 91b46ca41..a43692b98 100644 --- a/src/map/lapack2flamec/check/dgebd2_check.c +++ b/src/map/lapack2flamec/check/dgebd2_check.c @@ -32,7 +32,7 @@ int dgebd2_check(integer *m, integer *n, double *a, integer * lda, double *d__, if (*info < 0) { i__1 = -(*info); - xerbla_("DGEBD2", &i__1); + xerbla_("DGEBD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dgebrd_check.c b/src/map/lapack2flamec/check/dgebrd_check.c index cc646e660..6554c8ba5 100644 --- a/src/map/lapack2flamec/check/dgebrd_check.c +++ b/src/map/lapack2flamec/check/dgebrd_check.c @@ -63,7 +63,7 @@ int dgebrd_check(integer *m, integer *n, double *a, integer * lda, double *d__, if (*info < 0) { i__1 = -(*info); - xerbla_("DGEBRD", &i__1); + xerbla_("DGEBRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgehd2_check.c b/src/map/lapack2flamec/check/dgehd2_check.c index 3433d99c1..0d784bbf8 100644 --- a/src/map/lapack2flamec/check/dgehd2_check.c +++ b/src/map/lapack2flamec/check/dgehd2_check.c @@ -33,7 +33,7 @@ int dgehd2_check(integer *n, integer *ilo, integer *ihi, double *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DGEHD2", &i__1); + xerbla_("DGEHD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dgehrd_check.c b/src/map/lapack2flamec/check/dgehrd_check.c index d1603112e..11d10eb9e 100644 --- a/src/map/lapack2flamec/check/dgehrd_check.c +++ b/src/map/lapack2flamec/check/dgehrd_check.c @@ -51,7 +51,7 @@ int dgehrd_check(integer *n, integer *ilo, integer *ihi, double *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DGEHRD", &i__1); + xerbla_("DGEHRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgelq2_check.c b/src/map/lapack2flamec/check/dgelq2_check.c index fec275821..62699dd0b 100644 --- a/src/map/lapack2flamec/check/dgelq2_check.c +++ b/src/map/lapack2flamec/check/dgelq2_check.c @@ -29,7 +29,7 @@ int dgelq2_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQ2", &i__1); + xerbla_("DGELQ2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dgelqf_check.c b/src/map/lapack2flamec/check/dgelqf_check.c index 11fb34870..6a36d12cf 100644 --- a/src/map/lapack2flamec/check/dgelqf_check.c +++ b/src/map/lapack2flamec/check/dgelqf_check.c @@ -43,7 +43,7 @@ int dgelqf_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQF", &i__1); + xerbla_("DGELQF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgelsd_check.c b/src/map/lapack2flamec/check/dgelsd_check.c index 28a3c6388..ffe3d949d 100644 --- a/src/map/lapack2flamec/check/dgelsd_check.c +++ b/src/map/lapack2flamec/check/dgelsd_check.c @@ -205,7 +205,7 @@ int dgelsd_check(integer *m, integer *n, integer *nrhs, double *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELSD", &i__1); + xerbla_("DGELSD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgeqp3_check.c b/src/map/lapack2flamec/check/dgeqp3_check.c index cd93f6f1e..39861c8b9 100644 --- a/src/map/lapack2flamec/check/dgeqp3_check.c +++ b/src/map/lapack2flamec/check/dgeqp3_check.c @@ -58,7 +58,7 @@ int dgeqp3_check(integer *m, integer *n, double *a, integer * lda, integer *jpvt if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQP3", &i__1); + xerbla_("DGEQP3", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgeqpf_check.c b/src/map/lapack2flamec/check/dgeqpf_check.c index 750e385c6..c2d346ab2 100644 --- a/src/map/lapack2flamec/check/dgeqpf_check.c +++ b/src/map/lapack2flamec/check/dgeqpf_check.c @@ -30,7 +30,7 @@ int dgeqpf_check(integer *m, integer *n, double *a, integer * lda, integer *jpvt if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQPF", &i__1); + xerbla_("DGEQPF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dgeqr2_check.c b/src/map/lapack2flamec/check/dgeqr2_check.c index 1c5ddff21..c051ad729 100644 --- a/src/map/lapack2flamec/check/dgeqr2_check.c +++ b/src/map/lapack2flamec/check/dgeqr2_check.c @@ -29,7 +29,7 @@ int dgeqr2_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQR2", &i__1); + xerbla_("DGEQR2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dgeqr2p_check.c b/src/map/lapack2flamec/check/dgeqr2p_check.c index 8ac213192..c04f0c7d2 100644 --- a/src/map/lapack2flamec/check/dgeqr2p_check.c +++ b/src/map/lapack2flamec/check/dgeqr2p_check.c @@ -29,7 +29,7 @@ int dgeqr2p_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQR2P", &i__1); + xerbla_("DGEQR2P", &i__1, (ftnlen)7); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dgeqrf_check.c b/src/map/lapack2flamec/check/dgeqrf_check.c index e749c7aab..cbb18888b 100644 --- a/src/map/lapack2flamec/check/dgeqrf_check.c +++ b/src/map/lapack2flamec/check/dgeqrf_check.c @@ -43,7 +43,7 @@ int dgeqrf_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRF", &i__1); + xerbla_("DGEQRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgeqrfp_check.c b/src/map/lapack2flamec/check/dgeqrfp_check.c index f1e6130a0..90a5aa454 100644 --- a/src/map/lapack2flamec/check/dgeqrfp_check.c +++ b/src/map/lapack2flamec/check/dgeqrfp_check.c @@ -43,7 +43,7 @@ int dgeqrfp_check(integer *m, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRFP", &i__1); + xerbla_("DGEQRFP", &i__1, (ftnlen)7); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgesdd_check.c b/src/map/lapack2flamec/check/dgesdd_check.c index 135bf584d..c14a93798 100644 --- a/src/map/lapack2flamec/check/dgesdd_check.c +++ b/src/map/lapack2flamec/check/dgesdd_check.c @@ -35,11 +35,11 @@ int dgesdd_check(char *jobz, integer *m, integer *n, double * a, integer *lda, d /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntqa = lsame_(jobz, "A"); - wntqs = lsame_(jobz, "S"); + wntqa = lsame_(jobz, "A", 1, 1); + wntqs = lsame_(jobz, "S", 1, 1); wntqas = wntqa || wntqs; - wntqo = lsame_(jobz, "O"); - wntqn = lsame_(jobz, "N"); + wntqo = lsame_(jobz, "O", 1, 1); + wntqn = lsame_(jobz, "N", 1, 1); lquery = *lwork == -1; if (! (wntqa || wntqs || wntqo || wntqn)) { @@ -437,7 +437,7 @@ int dgesdd_check(char *jobz, integer *m, integer *n, double * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGESDD", &i__1); + xerbla_("DGESDD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgesdd_fla_check.c b/src/map/lapack2flamec/check/dgesdd_fla_check.c index 9814cce18..4a770f465 100644 --- a/src/map/lapack2flamec/check/dgesdd_fla_check.c +++ b/src/map/lapack2flamec/check/dgesdd_fla_check.c @@ -41,16 +41,16 @@ int dgesdd_fla_check(char *jobu, char *jobvt, integer *m, integer *n, double * a /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if ((! (wntua || wntus || wntuo || wntun)) || (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo)) { @@ -671,7 +671,7 @@ int dgesdd_fla_check(char *jobu, char *jobvt, integer *m, integer *n, double * a if (*info != 0) { i__2 = -(*info); - xerbla_("DGESVD", &i__2); + xerbla_("DGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgesvd_check.c b/src/map/lapack2flamec/check/dgesvd_check.c index 71b3ec92e..b2644f78f 100644 --- a/src/map/lapack2flamec/check/dgesvd_check.c +++ b/src/map/lapack2flamec/check/dgesvd_check.c @@ -41,16 +41,16 @@ int dgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, double *a, int /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if (! (wntua || wntus || wntuo || wntun)) { @@ -675,7 +675,7 @@ int dgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, double *a, int if (*info != 0) { i__2 = -(*info); - xerbla_("DGESVD", &i__2); + xerbla_("DGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dgetf2_check.c b/src/map/lapack2flamec/check/dgetf2_check.c index 3ae86bc41..492686b0c 100644 --- a/src/map/lapack2flamec/check/dgetf2_check.c +++ b/src/map/lapack2flamec/check/dgetf2_check.c @@ -28,7 +28,7 @@ int dgetf2_check(integer *m, integer *n, double *a, integer * lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DGETF2", &i__1); + xerbla_("DGETF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dgetrf_check.c b/src/map/lapack2flamec/check/dgetrf_check.c index 498112fd5..f8a0f3a21 100644 --- a/src/map/lapack2flamec/check/dgetrf_check.c +++ b/src/map/lapack2flamec/check/dgetrf_check.c @@ -27,7 +27,7 @@ int dgetrf_check(integer *m, integer *n, double *a, integer * lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRF", &i__1); + xerbla_("DGETRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dgetrfnp_check.c b/src/map/lapack2flamec/check/dgetrfnp_check.c index b5bc0023f..caf253767 100644 --- a/src/map/lapack2flamec/check/dgetrfnp_check.c +++ b/src/map/lapack2flamec/check/dgetrfnp_check.c @@ -31,7 +31,7 @@ int dgetrfnp_check(integer *m, integer *n, double *a, integer * lda, integer *in if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRFNP", &i__1); + xerbla_("DGETRFNP", &i__1, (ftnlen)8); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dgetrfnpi_check.c b/src/map/lapack2flamec/check/dgetrfnpi_check.c index 565ad3fc3..6ce5633cd 100644 --- a/src/map/lapack2flamec/check/dgetrfnpi_check.c +++ b/src/map/lapack2flamec/check/dgetrfnpi_check.c @@ -35,7 +35,7 @@ int dgetrfnpi_check(integer *m, integer *n, integer *nfact, double *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRFNPI", &i__1); + xerbla_("DGETRFNPI", &i__1, (ftnlen)9); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dlauu2_check.c b/src/map/lapack2flamec/check/dlauu2_check.c index eaf8da54d..815bf52b2 100644 --- a/src/map/lapack2flamec/check/dlauu2_check.c +++ b/src/map/lapack2flamec/check/dlauu2_check.c @@ -14,8 +14,8 @@ int dlauu2_check(char *uplo, integer *n, double *a, integer * lda, integer *info a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int dlauu2_check(char *uplo, integer *n, double *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DLAUU2", &i__1); + xerbla_("DLAUU2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dlauum_check.c b/src/map/lapack2flamec/check/dlauum_check.c index 56ef76f78..4e1306ecd 100644 --- a/src/map/lapack2flamec/check/dlauum_check.c +++ b/src/map/lapack2flamec/check/dlauum_check.c @@ -14,8 +14,8 @@ int dlauum_check(char *uplo, integer *n, double *a, integer * lda, integer *info a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int dlauum_check(char *uplo, integer *n, double *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DLAUUM", &i__1); + xerbla_("DLAUUM", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dorg2r_check.c b/src/map/lapack2flamec/check/dorg2r_check.c index f04421d35..1c77bfc33 100644 --- a/src/map/lapack2flamec/check/dorg2r_check.c +++ b/src/map/lapack2flamec/check/dorg2r_check.c @@ -33,7 +33,7 @@ int dorg2r_check(integer *m, integer *n, integer *k, double * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DORG2R", &i__1); + xerbla_("DORG2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dorgbr_check.c b/src/map/lapack2flamec/check/dorgbr_check.c index d54c608d0..3b5e5c5d4 100644 --- a/src/map/lapack2flamec/check/dorgbr_check.c +++ b/src/map/lapack2flamec/check/dorgbr_check.c @@ -25,10 +25,10 @@ int dorgbr_check(char *vect, integer *m, integer *n, integer *k, double *a, inte --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "Q"); + wantq = lsame_(vect, "Q", 1, 1); mn = fla_min(*m,*n); lquery = *lwork == -1; - if (! wantq && ! lsame_(vect, "P")) + if (! wantq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } @@ -95,7 +95,7 @@ int dorgbr_check(char *vect, integer *m, integer *n, integer *k, double *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DORGBR", &i__1); + xerbla_("DORGBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dorgl2_check.c b/src/map/lapack2flamec/check/dorgl2_check.c index b5a87d4ef..393a03bcb 100644 --- a/src/map/lapack2flamec/check/dorgl2_check.c +++ b/src/map/lapack2flamec/check/dorgl2_check.c @@ -32,7 +32,7 @@ int dorgl2_check(integer *m, integer *n, integer *k, double * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DORGL2", &i__1); + xerbla_("DORGL2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dorglq_check.c b/src/map/lapack2flamec/check/dorglq_check.c index 49599d9dd..2d74ab3c1 100644 --- a/src/map/lapack2flamec/check/dorglq_check.c +++ b/src/map/lapack2flamec/check/dorglq_check.c @@ -47,7 +47,7 @@ int dorglq_check(integer *m, integer *n, integer *k, double * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DORGLQ", &i__1); + xerbla_("DORGLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dorgqr_check.c b/src/map/lapack2flamec/check/dorgqr_check.c index 2645660ac..d27425b1a 100644 --- a/src/map/lapack2flamec/check/dorgqr_check.c +++ b/src/map/lapack2flamec/check/dorgqr_check.c @@ -47,7 +47,7 @@ int dorgqr_check(integer *m, integer *n, integer *k, double * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DORGQR", &i__1); + xerbla_("DORGQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dorgtr_check.c b/src/map/lapack2flamec/check/dorgtr_check.c index 80a8ce46a..3af8c77a1 100644 --- a/src/map/lapack2flamec/check/dorgtr_check.c +++ b/src/map/lapack2flamec/check/dorgtr_check.c @@ -22,8 +22,8 @@ int dorgtr_check(char *uplo, integer *n, double *a, integer * lda, double *tau, /* Function Body */ *info = 0; lquery = *lwork == -1; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -70,7 +70,7 @@ int dorgtr_check(char *uplo, integer *n, double *a, integer * lda, double *tau, if (*info != 0) { i__1 = -(*info); - xerbla_("DORGTR", &i__1); + xerbla_("DORGTR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dorm2r_check.c b/src/map/lapack2flamec/check/dorm2r_check.c index 8a6969a2a..436996d76 100644 --- a/src/map/lapack2flamec/check/dorm2r_check.c +++ b/src/map/lapack2flamec/check/dorm2r_check.c @@ -21,8 +21,8 @@ int dorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, do --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -32,11 +32,11 @@ int dorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, do { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -63,7 +63,7 @@ int dorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORM2R", &i__1); + xerbla_("DORM2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dormbr_check.c b/src/map/lapack2flamec/check/dormbr_check.c index d5042965e..07682d701 100644 --- a/src/map/lapack2flamec/check/dormbr_check.c +++ b/src/map/lapack2flamec/check/dormbr_check.c @@ -27,9 +27,9 @@ int dormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in --work; /* Function Body */ *info = 0; - applyq = lsame_(vect, "Q"); - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + applyq = lsame_(vect, "Q", 1, 1); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q or P and NW is the minimum dimension of WORK */ if (left) @@ -42,15 +42,15 @@ int dormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in nq = *n; nw = *m; } - if (! applyq && ! lsame_(vect, "P")) + if (! applyq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } - else if (! left && ! lsame_(side, "R")) + else if (! left && ! lsame_(side, "R", 1, 1)) { *info = -2; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -3; } @@ -122,7 +122,7 @@ int dormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in if (*info != 0) { i__1 = -(*info); - xerbla_("DORMBR", &i__1); + xerbla_("DORMBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dorml2_check.c b/src/map/lapack2flamec/check/dorml2_check.c index 2a9beda97..cc0ec4f6d 100644 --- a/src/map/lapack2flamec/check/dorml2_check.c +++ b/src/map/lapack2flamec/check/dorml2_check.c @@ -21,8 +21,8 @@ int dorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, do --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -32,11 +32,11 @@ int dorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, do { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -63,7 +63,7 @@ int dorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORML2", &i__1); + xerbla_("DORML2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dormlq_check.c b/src/map/lapack2flamec/check/dormlq_check.c index e07a4a8dc..de702af7b 100644 --- a/src/map/lapack2flamec/check/dormlq_check.c +++ b/src/map/lapack2flamec/check/dormlq_check.c @@ -26,8 +26,8 @@ int dormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, do --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -40,11 +40,11 @@ int dormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, do nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -86,7 +86,7 @@ int dormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORMLQ", &i__1); + xerbla_("DORMLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dormqr_check.c b/src/map/lapack2flamec/check/dormqr_check.c index 3a9d5e8b4..3c581a6b5 100644 --- a/src/map/lapack2flamec/check/dormqr_check.c +++ b/src/map/lapack2flamec/check/dormqr_check.c @@ -27,8 +27,8 @@ int dormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, do --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int dormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, do nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -87,7 +87,7 @@ int dormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORMQR", &i__1); + xerbla_("DORMQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dormtr_check.c b/src/map/lapack2flamec/check/dormtr_check.c index fe9d92766..b4a4108e6 100644 --- a/src/map/lapack2flamec/check/dormtr_check.c +++ b/src/map/lapack2flamec/check/dormtr_check.c @@ -29,8 +29,8 @@ int dormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, do --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - upper = lsame_(uplo, "U"); + left = lsame_(side, "L", 1, 1); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -43,15 +43,15 @@ int dormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, do nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } - else if (! lsame_(trans, "N") && ! lsame_(trans, "T")) + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, "T", 1, 1)) { *info = -3; } @@ -113,7 +113,7 @@ int dormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, do if (*info != 0) { i__2 = -(*info); - xerbla_("DORMTR", &i__2); + xerbla_("DORMTR", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dpotf2_check.c b/src/map/lapack2flamec/check/dpotf2_check.c index 13e7e8117..a2445d824 100644 --- a/src/map/lapack2flamec/check/dpotf2_check.c +++ b/src/map/lapack2flamec/check/dpotf2_check.c @@ -14,8 +14,8 @@ int dpotf2_check(char *uplo, integer *n, double *a, integer * lda, integer *info a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int dpotf2_check(char *uplo, integer *n, double *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTF2", &i__1); + xerbla_("DPOTF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dpotrf_check.c b/src/map/lapack2flamec/check/dpotrf_check.c index c0fcc7706..0a35ff103 100644 --- a/src/map/lapack2flamec/check/dpotrf_check.c +++ b/src/map/lapack2flamec/check/dpotrf_check.c @@ -14,8 +14,8 @@ int dpotrf_check(char *uplo, integer *n, double *a, integer * lda, integer *info a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int dpotrf_check(char *uplo, integer *n, double *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTRF", &i__1); + xerbla_("DPOTRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dpotri_check.c b/src/map/lapack2flamec/check/dpotri_check.c index 1d6e83848..8e3d3ee20 100644 --- a/src/map/lapack2flamec/check/dpotri_check.c +++ b/src/map/lapack2flamec/check/dpotri_check.c @@ -12,7 +12,7 @@ int dpotri_check(char *uplo, integer *n, double *a, integer * lda, integer *info a -= a_offset; /* Function Body */ *info = 0; - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -27,7 +27,7 @@ int dpotri_check(char *uplo, integer *n, double *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTRI", &i__1); + xerbla_("DPOTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dsygs2_check.c b/src/map/lapack2flamec/check/dsygs2_check.c index 91a521f9d..bb7249632 100644 --- a/src/map/lapack2flamec/check/dsygs2_check.c +++ b/src/map/lapack2flamec/check/dsygs2_check.c @@ -16,12 +16,12 @@ int dsygs2_check(integer *itype, char *uplo, integer *n, double *a, integer *lda b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -40,7 +40,7 @@ int dsygs2_check(integer *itype, char *uplo, integer *n, double *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGS2", &i__1); + xerbla_("DSYGS2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dsygst_check.c b/src/map/lapack2flamec/check/dsygst_check.c index 06ebbca14..0fbd11dd9 100644 --- a/src/map/lapack2flamec/check/dsygst_check.c +++ b/src/map/lapack2flamec/check/dsygst_check.c @@ -17,12 +17,12 @@ int dsygst_check(integer *itype, char *uplo, integer *n, double *a, integer *lda b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -41,7 +41,7 @@ int dsygst_check(integer *itype, char *uplo, integer *n, double *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGST", &i__1); + xerbla_("DSYGST", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dsytd2_check.c b/src/map/lapack2flamec/check/dsytd2_check.c index e40d40b5f..6c654bde9 100644 --- a/src/map/lapack2flamec/check/dsytd2_check.c +++ b/src/map/lapack2flamec/check/dsytd2_check.c @@ -17,8 +17,8 @@ int dsytd2_check(char *uplo, integer *n, double *a, integer * lda, double *d__, --tau; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -33,7 +33,7 @@ int dsytd2_check(char *uplo, integer *n, double *a, integer * lda, double *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTD2", &i__1); + xerbla_("DSYTD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/dsytrd_check.c b/src/map/lapack2flamec/check/dsytrd_check.c index a4cbc47cb..15c0a03d5 100644 --- a/src/map/lapack2flamec/check/dsytrd_check.c +++ b/src/map/lapack2flamec/check/dsytrd_check.c @@ -23,9 +23,9 @@ int dsytrd_check(char *uplo, integer *n, double *a, integer * lda, double *d__, --work; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; - if (! upper && ! lsame_(uplo, "L")) + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -51,7 +51,7 @@ int dsytrd_check(char *uplo, integer *n, double *a, integer * lda, double *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD", &i__1); + xerbla_("DSYTRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/dtrti2_check.c b/src/map/lapack2flamec/check/dtrti2_check.c index 244bf9a8c..9582588de 100644 --- a/src/map/lapack2flamec/check/dtrti2_check.c +++ b/src/map/lapack2flamec/check/dtrti2_check.c @@ -15,13 +15,13 @@ int dtrti2_check(char *uplo, char *diag, integer *n, double * a, integer *lda, i a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -36,7 +36,7 @@ int dtrti2_check(char *uplo, char *diag, integer *n, double * a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("DTRTI2", &i__1); + xerbla_("DTRTI2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/dtrtri_check.c b/src/map/lapack2flamec/check/dtrtri_check.c index 000a61e85..ca4169b50 100644 --- a/src/map/lapack2flamec/check/dtrtri_check.c +++ b/src/map/lapack2flamec/check/dtrtri_check.c @@ -15,13 +15,13 @@ int dtrtri_check(char *uplo, char *diag, integer *n, double * a, integer *lda, i a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -36,7 +36,7 @@ int dtrtri_check(char *uplo, char *diag, integer *n, double * a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("DTRTRI", &i__1); + xerbla_("DTRTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/other/FLA_hegst.in b/src/map/lapack2flamec/check/other/FLA_hegst.in index b989a607c..b3616dc83 100644 --- a/src/map/lapack2flamec/check/other/FLA_hegst.in +++ b/src/map/lapack2flamec/check/other/FLA_hegst.in @@ -8,7 +8,7 @@ \ *info = 0; \ if (*itype < 1 || *itype > 3) *info = -1; \ - else if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -2; \ + else if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -2; \ else if (*n < 0) *info = -3; \ else if (*ldim_A < fla_max(1,*n)) *info = -5; \ else if (*ldim_B < fla_max(1,*n)) *info = -7; \ diff --git a/src/map/lapack2flamec/check/other/FLA_hetrd.in b/src/map/lapack2flamec/check/other/FLA_hetrd.in index 6433d9ef8..c4fc8a314 100644 --- a/src/map/lapack2flamec/check/other/FLA_hetrd.in +++ b/src/map/lapack2flamec/check/other/FLA_hetrd.in @@ -3,7 +3,7 @@ int _lquery = (*lwork == -1), _nb; \ int _i1 = 1, _i2 = -1; \ *info = 0; \ - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -1; \ + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -1; \ else if (*m < 0) *info = -2; \ else if (*ldim_A < fla_max(1,*m)) *info = -4; \ else if (*lwork < 1 && ! _lquery) *info = -9; @@ -22,7 +22,7 @@ #define LAPACK_hetrd_op_unblocked \ *info = 0; \ - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -1; \ + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -1; \ else if (*m < 0) *info = -2; \ else if (*ldim_A < fla_max(1,*m)) *info = -4; diff --git a/src/map/lapack2flamec/check/other/FLA_lauum.in b/src/map/lapack2flamec/check/other/FLA_lauum.in index 3deaf2dfd..9ef92f40e 100644 --- a/src/map/lapack2flamec/check/other/FLA_lauum.in +++ b/src/map/lapack2flamec/check/other/FLA_lauum.in @@ -9,7 +9,7 @@ LAPACK_common_op_check(prefix, srname) \ \ *info = 0; \ - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -1; \ + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -1; \ else if (*n < 0) *info = -2; \ else if (*ldim_A < fla_max(1,*n)) *info = -4; \ \ diff --git a/src/map/lapack2flamec/check/other/FLA_orgbr.in b/src/map/lapack2flamec/check/other/FLA_orgbr.in index e97029a41..018db339c 100644 --- a/src/map/lapack2flamec/check/other/FLA_orgbr.in +++ b/src/map/lapack2flamec/check/other/FLA_orgbr.in @@ -7,9 +7,9 @@ } #define LAPACK_orgbr_op_check(prefix, srname) \ - int _lquery = (*lwork == -1), _wantq = lsame_(vect, "Q"); \ + int _lquery = (*lwork == -1), _wantq = lsame_(vect, "Q", 1, 1); \ *info = 0; \ - if (! _wantq && ! lsame_(vect, "P")) *info = -1; \ + if (! _wantq && ! lsame_(vect, "P", 1, 1)) *info = -1; \ else if (*m < 0) *info = -2; \ else if (*n < 0 || \ _wantq && (*n > *m || *n < fla_min(*m,*k)) || \ diff --git a/src/map/lapack2flamec/check/other/FLA_ormbr.in b/src/map/lapack2flamec/check/other/FLA_ormbr.in index 0ee2e60dd..3dbd2dee3 100644 --- a/src/map/lapack2flamec/check/other/FLA_ormbr.in +++ b/src/map/lapack2flamec/check/other/FLA_ormbr.in @@ -8,15 +8,15 @@ #define LAPACK_ormbr_op_check(prefix, srname) \ int _lquery = (*lwork == -1), _nb, \ - left = lsame_(side, "L"), _applyq = lsame_(vect, "Q"), \ + left = lsame_(side, "L", 1, 1), _applyq = lsame_(vect, "Q", 1, 1), \ nq, nw; \ *info = 0; \ if (left ) { nq = *m; nw = *n; } \ else /* (right) */ { nq = *n; nw = *m; } \ \ - if (! _applyq && ! lsame_(vect, "P")) *info = -1; \ - else if (! lsame_(side, "L") && ! lsame_(side, "R")) *info = -2; \ - else if (! lsame_(trans, "N") && ! lsame_(trans, "T")) *info = -3; \ + if (! _applyq && ! lsame_(vect, "P", 1, 1)) *info = -1; \ + else if (! lsame_(side, "L", 1, 1) && ! lsame_(side, "R", 1, 1)) *info = -2; \ + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, "T", 1, 1)) *info = -3; \ else if (*m < 0) *info = -4; \ else if (*n < 0) *info = -5; \ else if (*k < 0) *info = -6; \ diff --git a/src/map/lapack2flamec/check/other/FLA_ormlq.in b/src/map/lapack2flamec/check/other/FLA_ormlq.in index 441b62e63..26758a511 100644 --- a/src/map/lapack2flamec/check/other/FLA_ormlq.in +++ b/src/map/lapack2flamec/check/other/FLA_ormlq.in @@ -2,11 +2,11 @@ #define LAPACK_ormlq_op_blocked(prefix) \ int _nb, _nw, _nq, _lquery = (*lwork == -1); \ int _i1 = 1, _i2 = -1; \ - if ( lsame_(side, "L") ) { _nq = *m; _nw = *n; } \ + if ( lsame_(side, "L", 1, 1) ) { _nq = *m; _nw = *n; } \ else { _nq = *n; _nw = *m; } \ *info = 0; \ if (! lsame_(side, "L") && ! lsame_(side, "R")) *info = -1; \ - else if (! lsame_(trans, "N") && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ else if (*m < 0) *info = -3; \ else if (*n < 0) *info = -4; \ else if (*k < 0 || *k > _nq) *info = -5; \ @@ -18,11 +18,11 @@ int _nb, _nw=1, _nq, _lquery = 0; \ int _i1 = 1, _i2 = -1; \ \ - if ( lsame_(side, "L") ) _nq = *m; \ + if ( lsame_(side, "L", 1, 1) ) _nq = *m; \ else _nq = *n; \ *info = 0; \ if (! lsame_(side, "L") && ! lsame_(side, "R")) *info = -1; \ - else if (! lsame_(trans, "N") && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ else if (*m < 0) *info = -3; \ else if (*n < 0) *info = -4; \ else if (*k < 0 || *k > _nq) *info = -5; \ diff --git a/src/map/lapack2flamec/check/other/FLA_ormqr.in b/src/map/lapack2flamec/check/other/FLA_ormqr.in index 02143729f..2fbd4bd85 100644 --- a/src/map/lapack2flamec/check/other/FLA_ormqr.in +++ b/src/map/lapack2flamec/check/other/FLA_ormqr.in @@ -2,7 +2,7 @@ #define LAPACK_ormqr_op_blocked(prefix) \ int _nb, _nw, _nq, _lquery = (*lwork == -1); \ int _i1 = 1, _i2 = -1; \ - if ( lsame_(side, "L") ) { \ + if ( lsame_(side, "L", 1, 1) ) { \ _nq = *m; \ _nw = *n; \ } else { \ @@ -11,7 +11,7 @@ } \ *info = 0; \ if (! lsame_(side, "L") && ! lsame_(side, "R")) *info = -1; \ - else if (! lsame_(trans, "N") && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ else if (*m < 0) *info = -3; \ else if (*n < 0) *info = -4; \ else if (*k < 0 || *k > _nq) *info = -5; \ @@ -22,11 +22,11 @@ #define LAPACK_ormqr_op_unblocked(prefix) \ int _nb, _nw=1, _nq, _lquery = 0; \ int _i1 = 1, _i2 = -1; \ - if ( lsame_(side, "L") ) _nq = *m; \ + if ( lsame_(side, "L", 1, 1) ) _nq = *m; \ else _nq = *n; \ *info = 0; \ if (! lsame_(side, "L") && ! lsame_(side, "R")) *info = -1; \ - else if (! lsame_(trans, "N") && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, PREFIX2LAPACK_TRANS(prefix))) *info = -2; \ else if (*m < 0) *info = -3; \ else if (*n < 0) *info = -4; \ else if (*k < 0 || *k > _nq) *info = -5; \ diff --git a/src/map/lapack2flamec/check/other/FLA_potrf.in b/src/map/lapack2flamec/check/other/FLA_potrf.in index 897aa5ff9..282db6bc3 100644 --- a/src/map/lapack2flamec/check/other/FLA_potrf.in +++ b/src/map/lapack2flamec/check/other/FLA_potrf.in @@ -7,7 +7,7 @@ LAPACK_common_op_check(prefix, srname) \ \ *info = 0; \ - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -1; \ + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -1; \ else if (*n < 0) *info = -2; \ else if (*ldim_A < fla_max(1,*n)) *info = -4; \ \ diff --git a/src/map/lapack2flamec/check/other/FLA_trtri.in b/src/map/lapack2flamec/check/other/FLA_trtri.in index c79a7e871..881364f29 100644 --- a/src/map/lapack2flamec/check/other/FLA_trtri.in +++ b/src/map/lapack2flamec/check/other/FLA_trtri.in @@ -7,8 +7,8 @@ LAPACK_common_op_check(prefix, srname) \ \ *info = 0; \ - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) *info = -1; \ - else if (! lsame_(diag, "N") && ! lsame_(diag, "U")) *info = -2; \ + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) *info = -1; \ + else if (! lsame_(diag, "N", 1, 1) && ! lsame_(diag, "U", 1, 1)) *info = -2; \ else if (*n < 0) *info = -3; \ else if (*ldim_A < fla_max(1,*n)) *info = -5; \ \ diff --git a/src/map/lapack2flamec/check/sbdsqr_check.c b/src/map/lapack2flamec/check/sbdsqr_check.c index 44d0f934e..a23c125f5 100644 --- a/src/map/lapack2flamec/check/sbdsqr_check.c +++ b/src/map/lapack2flamec/check/sbdsqr_check.c @@ -33,8 +33,8 @@ int sbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * --work; /* Function Body */ *info = 0; - lower = lsame_(uplo, "L"); - if (! lsame_(uplo, "U") && ! lower) + lower = lsame_(uplo, "L", 1, 1); + if (! lsame_(uplo, "U", 1, 1) && ! lower) { *info = -1; } @@ -69,7 +69,7 @@ int sbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SBDSQR", &i__1); + xerbla_("SBDSQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*n == 0) diff --git a/src/map/lapack2flamec/check/sgebd2_check.c b/src/map/lapack2flamec/check/sgebd2_check.c index 129a248d2..0aa199587 100644 --- a/src/map/lapack2flamec/check/sgebd2_check.c +++ b/src/map/lapack2flamec/check/sgebd2_check.c @@ -32,7 +32,7 @@ int sgebd2_check(integer *m, integer *n, float *a, integer *lda, float *d__, flo if (*info < 0) { i__1 = -(*info); - xerbla_("SGEBD2", &i__1); + xerbla_("SGEBD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/sgebrd_check.c b/src/map/lapack2flamec/check/sgebrd_check.c index b2799d027..75f46bdfd 100644 --- a/src/map/lapack2flamec/check/sgebrd_check.c +++ b/src/map/lapack2flamec/check/sgebrd_check.c @@ -54,7 +54,7 @@ int sgebrd_check(integer *m, integer *n, float *a, integer *lda, float *d__, flo if (*info < 0) { i__1 = -(*info); - xerbla_("SGEBRD", &i__1); + xerbla_("SGEBRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgehd2_check.c b/src/map/lapack2flamec/check/sgehd2_check.c index 55114407f..7b028c938 100644 --- a/src/map/lapack2flamec/check/sgehd2_check.c +++ b/src/map/lapack2flamec/check/sgehd2_check.c @@ -33,7 +33,7 @@ int sgehd2_check(integer *n, integer *ilo, integer *ihi, float *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEHD2", &i__1); + xerbla_("SGEHD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/sgehrd_check.c b/src/map/lapack2flamec/check/sgehrd_check.c index 5ef847078..570c17d50 100644 --- a/src/map/lapack2flamec/check/sgehrd_check.c +++ b/src/map/lapack2flamec/check/sgehrd_check.c @@ -51,7 +51,7 @@ int sgehrd_check(integer *n, integer *ilo, integer *ihi, float *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEHRD", &i__1); + xerbla_("SGEHRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgelq2_check.c b/src/map/lapack2flamec/check/sgelq2_check.c index cf6588410..57a425166 100644 --- a/src/map/lapack2flamec/check/sgelq2_check.c +++ b/src/map/lapack2flamec/check/sgelq2_check.c @@ -30,7 +30,7 @@ int sgelq2_check(integer *m, integer *n, float *a, integer *lda, float *tau, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQ2", &i__1); + xerbla_("SGELQ2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/sgelqf_check.c b/src/map/lapack2flamec/check/sgelqf_check.c index 0020d957a..1adc59c00 100644 --- a/src/map/lapack2flamec/check/sgelqf_check.c +++ b/src/map/lapack2flamec/check/sgelqf_check.c @@ -43,7 +43,7 @@ int sgelqf_check(integer *m, integer *n, float *a, integer *lda, float *tau, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQF", &i__1); + xerbla_("SGELQF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgelsd_check.c b/src/map/lapack2flamec/check/sgelsd_check.c index 6922a4a0d..665a72f46 100644 --- a/src/map/lapack2flamec/check/sgelsd_check.c +++ b/src/map/lapack2flamec/check/sgelsd_check.c @@ -208,7 +208,7 @@ int sgelsd_check(integer *m, integer *n, integer *nrhs, float *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("SGELSD", &i__1); + xerbla_("SGELSD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgeqp3_check.c b/src/map/lapack2flamec/check/sgeqp3_check.c index 26e315a6a..2d9078046 100644 --- a/src/map/lapack2flamec/check/sgeqp3_check.c +++ b/src/map/lapack2flamec/check/sgeqp3_check.c @@ -58,7 +58,7 @@ int sgeqp3_check(integer *m, integer *n, float *a, integer *lda, integer *jpvt, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQP3", &i__1); + xerbla_("SGEQP3", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgeqpf_check.c b/src/map/lapack2flamec/check/sgeqpf_check.c index e8c2bf33d..4e3d48453 100644 --- a/src/map/lapack2flamec/check/sgeqpf_check.c +++ b/src/map/lapack2flamec/check/sgeqpf_check.c @@ -30,7 +30,7 @@ int sgeqpf_check(integer *m, integer *n, float *a, integer *lda, integer *jpvt, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQPF", &i__1); + xerbla_("SGEQPF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sgeqr2_check.c b/src/map/lapack2flamec/check/sgeqr2_check.c index d9fc4abf6..2e91a6ba2 100644 --- a/src/map/lapack2flamec/check/sgeqr2_check.c +++ b/src/map/lapack2flamec/check/sgeqr2_check.c @@ -29,7 +29,7 @@ int sgeqr2_check(integer *m, integer *n, float *a, integer *lda, float *tau, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQR2", &i__1); + xerbla_("SGEQR2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sgeqr2p_check.c b/src/map/lapack2flamec/check/sgeqr2p_check.c index eee94bddc..ba6ee3948 100644 --- a/src/map/lapack2flamec/check/sgeqr2p_check.c +++ b/src/map/lapack2flamec/check/sgeqr2p_check.c @@ -29,7 +29,7 @@ int sgeqr2p_check(integer *m, integer *n, float *a, integer *lda, float *tau, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQR2P", &i__1); + xerbla_("SGEQR2P", &i__1, (ftnlen)7); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/sgeqrf_check.c b/src/map/lapack2flamec/check/sgeqrf_check.c index 1052d0233..8cb0cef42 100644 --- a/src/map/lapack2flamec/check/sgeqrf_check.c +++ b/src/map/lapack2flamec/check/sgeqrf_check.c @@ -43,7 +43,7 @@ int sgeqrf_check(integer *m, integer *n, float *a, integer *lda, float *tau, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRF", &i__1); + xerbla_("SGEQRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgeqrfp_check.c b/src/map/lapack2flamec/check/sgeqrfp_check.c index 21a56bc79..09f534fcc 100644 --- a/src/map/lapack2flamec/check/sgeqrfp_check.c +++ b/src/map/lapack2flamec/check/sgeqrfp_check.c @@ -43,7 +43,7 @@ int sgeqrfp_check(integer *m, integer *n, float *a, integer *lda, float *tau, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRFP", &i__1); + xerbla_("SGEQRFP", &i__1, (ftnlen)7); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgesdd_check.c b/src/map/lapack2flamec/check/sgesdd_check.c index 5ff6e93e6..6d532bdd7 100644 --- a/src/map/lapack2flamec/check/sgesdd_check.c +++ b/src/map/lapack2flamec/check/sgesdd_check.c @@ -36,11 +36,11 @@ int sgesdd_check(char *jobz, integer *m, integer *n, real *a, integer *lda, real /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntqa = lsame_(jobz, "A"); - wntqs = lsame_(jobz, "S"); + wntqa = lsame_(jobz, "A", 1, 1); + wntqs = lsame_(jobz, "S", 1, 1); wntqas = wntqa || wntqs; - wntqo = lsame_(jobz, "O"); - wntqn = lsame_(jobz, "N"); + wntqo = lsame_(jobz, "O", 1, 1); + wntqn = lsame_(jobz, "N", 1, 1); lquery = *lwork == -1; if (! (wntqa || wntqs || wntqo || wntqn)) { @@ -438,7 +438,7 @@ int sgesdd_check(char *jobz, integer *m, integer *n, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGESDD", &i__1); + xerbla_("SGESDD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgesdd_fla_check.c b/src/map/lapack2flamec/check/sgesdd_fla_check.c index e1de7abbc..d03a0dedf 100644 --- a/src/map/lapack2flamec/check/sgesdd_fla_check.c +++ b/src/map/lapack2flamec/check/sgesdd_fla_check.c @@ -41,16 +41,16 @@ int sgesdd_fla_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if ((! (wntua || wntus || wntuo || wntun)) || (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo)) { @@ -672,7 +672,7 @@ int sgesdd_fla_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, if (*info != 0) { i__2 = -(*info); - xerbla_("SGESVD", &i__2); + xerbla_("SGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgesvd_check.c b/src/map/lapack2flamec/check/sgesvd_check.c index 6b943c650..6362711f7 100644 --- a/src/map/lapack2flamec/check/sgesvd_check.c +++ b/src/map/lapack2flamec/check/sgesvd_check.c @@ -41,16 +41,16 @@ int sgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, inte /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if (! (wntua || wntus || wntuo || wntun)) { @@ -676,7 +676,7 @@ int sgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, float *a, inte if (*info != 0) { i__2 = -(*info); - xerbla_("SGESVD", &i__2); + xerbla_("SGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sgetf2_check.c b/src/map/lapack2flamec/check/sgetf2_check.c index bec0b887a..c1a9deb10 100644 --- a/src/map/lapack2flamec/check/sgetf2_check.c +++ b/src/map/lapack2flamec/check/sgetf2_check.c @@ -28,7 +28,7 @@ int sgetf2_check(integer *m, integer *n, float *a, integer *lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SGETF2", &i__1); + xerbla_("SGETF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sgetrf_check.c b/src/map/lapack2flamec/check/sgetrf_check.c index 1c5cb3334..b9dbf006c 100644 --- a/src/map/lapack2flamec/check/sgetrf_check.c +++ b/src/map/lapack2flamec/check/sgetrf_check.c @@ -27,7 +27,7 @@ int sgetrf_check(integer *m, integer *n, float *a, integer *lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRF", &i__1); + xerbla_("SGETRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sgetrfnp_check.c b/src/map/lapack2flamec/check/sgetrfnp_check.c index 621c5c68c..e94d74a3b 100644 --- a/src/map/lapack2flamec/check/sgetrfnp_check.c +++ b/src/map/lapack2flamec/check/sgetrfnp_check.c @@ -31,7 +31,7 @@ int sgetrfnp_check(integer *m, integer *n, float *a, integer * lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRFNP", &i__1); + xerbla_("SGETRFNP", &i__1, (ftnlen)8); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sgetrfnpi_check.c b/src/map/lapack2flamec/check/sgetrfnpi_check.c index 38e03fb62..883b8e8ec 100644 --- a/src/map/lapack2flamec/check/sgetrfnpi_check.c +++ b/src/map/lapack2flamec/check/sgetrfnpi_check.c @@ -35,7 +35,7 @@ int sgetrfnpi_check(integer *m, integer *n, integer *nfact, float *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRFNPI", &i__1); + xerbla_("SGETRFNPI", &i__1, (ftnlen)9); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/slauu2_check.c b/src/map/lapack2flamec/check/slauu2_check.c index d9c6652a0..a10bc3d49 100644 --- a/src/map/lapack2flamec/check/slauu2_check.c +++ b/src/map/lapack2flamec/check/slauu2_check.c @@ -14,8 +14,8 @@ int slauu2_check(char *uplo, integer *n, float *a, integer *lda, integer *info) a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int slauu2_check(char *uplo, integer *n, float *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SLAUU2", &i__1); + xerbla_("SLAUU2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/slauum_check.c b/src/map/lapack2flamec/check/slauum_check.c index 2b86135b7..82e56f3d7 100644 --- a/src/map/lapack2flamec/check/slauum_check.c +++ b/src/map/lapack2flamec/check/slauum_check.c @@ -14,8 +14,8 @@ int slauum_check(char *uplo, integer *n, float *a, integer *lda, integer *info) a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int slauum_check(char *uplo, integer *n, float *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SLAUUM", &i__1); + xerbla_("SLAUUM", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sorg2r_check.c b/src/map/lapack2flamec/check/sorg2r_check.c index 865eac6f9..f3fe26b49 100644 --- a/src/map/lapack2flamec/check/sorg2r_check.c +++ b/src/map/lapack2flamec/check/sorg2r_check.c @@ -33,7 +33,7 @@ int sorg2r_check(integer *m, integer *n, integer *k, float *a, integer *lda, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SORG2R", &i__1); + xerbla_("SORG2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sorgbr_check.c b/src/map/lapack2flamec/check/sorgbr_check.c index 5e917eee5..86bb5950e 100644 --- a/src/map/lapack2flamec/check/sorgbr_check.c +++ b/src/map/lapack2flamec/check/sorgbr_check.c @@ -32,10 +32,10 @@ int sorgbr_check(char *vect, integer *m, integer *n, integer *k, float *a, integ --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "Q"); + wantq = lsame_(vect, "Q", 1, 1); mn = fla_min(*m,*n); lquery = *lwork == -1; - if (! wantq && ! lsame_(vect, "P")) + if (! wantq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } @@ -102,7 +102,7 @@ int sorgbr_check(char *vect, integer *m, integer *n, integer *k, float *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SORGBR", &i__1); + xerbla_("SORGBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sorgl2_check.c b/src/map/lapack2flamec/check/sorgl2_check.c index 7db25aa44..649886e47 100644 --- a/src/map/lapack2flamec/check/sorgl2_check.c +++ b/src/map/lapack2flamec/check/sorgl2_check.c @@ -33,7 +33,7 @@ int sorgl2_check(integer *m, integer *n, integer *k, float *a, integer *lda, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SORGL2", &i__1); + xerbla_("SORGL2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sorglq_check.c b/src/map/lapack2flamec/check/sorglq_check.c index 772cce7aa..b36221ccd 100644 --- a/src/map/lapack2flamec/check/sorglq_check.c +++ b/src/map/lapack2flamec/check/sorglq_check.c @@ -47,7 +47,7 @@ int sorglq_check(integer *m, integer *n, integer *k, float *a, integer *lda, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SORGLQ", &i__1); + xerbla_("SORGLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sorgqr_check.c b/src/map/lapack2flamec/check/sorgqr_check.c index bc9682497..1184aa542 100644 --- a/src/map/lapack2flamec/check/sorgqr_check.c +++ b/src/map/lapack2flamec/check/sorgqr_check.c @@ -47,7 +47,7 @@ int sorgqr_check(integer *m, integer *n, integer *k, float *a, integer *lda, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SORGQR", &i__1); + xerbla_("SORGQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sorgtr_check.c b/src/map/lapack2flamec/check/sorgtr_check.c index 26078a619..b136cc1a8 100644 --- a/src/map/lapack2flamec/check/sorgtr_check.c +++ b/src/map/lapack2flamec/check/sorgtr_check.c @@ -22,8 +22,8 @@ int sorgtr_check(char *uplo, integer *n, float *a, integer *lda, float *tau, flo /* Function Body */ *info = 0; lquery = *lwork == -1; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -70,7 +70,7 @@ int sorgtr_check(char *uplo, integer *n, float *a, integer *lda, float *tau, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SORGTR", &i__1); + xerbla_("SORGTR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sorm2r_check.c b/src/map/lapack2flamec/check/sorm2r_check.c index 7dd4200b2..4e238ad0b 100644 --- a/src/map/lapack2flamec/check/sorm2r_check.c +++ b/src/map/lapack2flamec/check/sorm2r_check.c @@ -21,8 +21,8 @@ int sorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, fl --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -32,11 +32,11 @@ int sorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, fl { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -63,7 +63,7 @@ int sorm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SORM2R", &i__1); + xerbla_("SORM2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sormbr_check.c b/src/map/lapack2flamec/check/sormbr_check.c index 5e339ea79..251167021 100644 --- a/src/map/lapack2flamec/check/sormbr_check.c +++ b/src/map/lapack2flamec/check/sormbr_check.c @@ -27,9 +27,9 @@ int sormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in --work; /* Function Body */ *info = 0; - applyq = lsame_(vect, "Q"); - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + applyq = lsame_(vect, "Q", 1, 1); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q or P and NW is the minimum dimension of WORK */ if (left) @@ -42,15 +42,15 @@ int sormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in nq = *n; nw = *m; } - if (! applyq && ! lsame_(vect, "P")) + if (! applyq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } - else if (! left && ! lsame_(side, "R")) + else if (! left && ! lsame_(side, "R", 1, 1)) { *info = -2; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -3; } @@ -122,7 +122,7 @@ int sormbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in if (*info != 0) { i__1 = -(*info); - xerbla_("SORMBR", &i__1); + xerbla_("SORMBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sorml2_check.c b/src/map/lapack2flamec/check/sorml2_check.c index dbdd700ec..b760c6276 100644 --- a/src/map/lapack2flamec/check/sorml2_check.c +++ b/src/map/lapack2flamec/check/sorml2_check.c @@ -20,8 +20,8 @@ int sorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, fl --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -31,11 +31,11 @@ int sorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, fl { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -62,7 +62,7 @@ int sorml2_check(char *side, char *trans, integer *m, integer *n, integer *k, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SORML2", &i__1); + xerbla_("SORML2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/sormlq_check.c b/src/map/lapack2flamec/check/sormlq_check.c index ab090936a..a91f2cb7e 100644 --- a/src/map/lapack2flamec/check/sormlq_check.c +++ b/src/map/lapack2flamec/check/sormlq_check.c @@ -27,8 +27,8 @@ int sormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, fl --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int sormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, fl nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -87,7 +87,7 @@ int sormlq_check(char *side, char *trans, integer *m, integer *n, integer *k, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SORMLQ", &i__1); + xerbla_("SORMLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sormqr_check.c b/src/map/lapack2flamec/check/sormqr_check.c index 337717b40..000386a23 100644 --- a/src/map/lapack2flamec/check/sormqr_check.c +++ b/src/map/lapack2flamec/check/sormqr_check.c @@ -27,8 +27,8 @@ int sormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, fl --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int sormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, fl nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "T")) + else if (! notran && ! lsame_(trans, "T", 1, 1)) { *info = -2; } @@ -87,7 +87,7 @@ int sormqr_check(char *side, char *trans, integer *m, integer *n, integer *k, fl if (*info != 0) { i__1 = -(*info); - xerbla_("SORMQR", &i__1); + xerbla_("SORMQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/sormtr_check.c b/src/map/lapack2flamec/check/sormtr_check.c index 2780ff891..42be8c56d 100644 --- a/src/map/lapack2flamec/check/sormtr_check.c +++ b/src/map/lapack2flamec/check/sormtr_check.c @@ -26,8 +26,8 @@ int sormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, fl --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - upper = lsame_(uplo, "U"); + left = lsame_(side, "L", 1, 1); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -40,15 +40,15 @@ int sormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, fl nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } - else if (! lsame_(trans, "N") && ! lsame_(trans, "T")) + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, "T", 1, 1)) { *info = -3; } @@ -110,7 +110,7 @@ int sormtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, fl if (*info != 0) { i__2 = -(*info); - xerbla_("SORMTR", &i__2); + xerbla_("SORMTR", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/spotf2_check.c b/src/map/lapack2flamec/check/spotf2_check.c index e6b1a2fb6..e43412557 100644 --- a/src/map/lapack2flamec/check/spotf2_check.c +++ b/src/map/lapack2flamec/check/spotf2_check.c @@ -14,8 +14,8 @@ int spotf2_check(char *uplo, integer *n, float *a, integer *lda, integer *info) a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int spotf2_check(char *uplo, integer *n, float *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPOTF2", &i__1); + xerbla_("SPOTF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/spotrf_check.c b/src/map/lapack2flamec/check/spotrf_check.c index 711f2a712..a095c1a0a 100644 --- a/src/map/lapack2flamec/check/spotrf_check.c +++ b/src/map/lapack2flamec/check/spotrf_check.c @@ -14,8 +14,8 @@ int spotrf_check(char *uplo, integer *n, float *a, integer *lda, integer *info) a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int spotrf_check(char *uplo, integer *n, float *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPOTRF", &i__1); + xerbla_("SPOTRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/spotri_check.c b/src/map/lapack2flamec/check/spotri_check.c index bf54e836f..6de184515 100644 --- a/src/map/lapack2flamec/check/spotri_check.c +++ b/src/map/lapack2flamec/check/spotri_check.c @@ -12,7 +12,7 @@ int spotri_check(char *uplo, integer *n, float *a, integer *lda, integer *info) a -= a_offset; /* Function Body */ *info = 0; - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -27,7 +27,7 @@ int spotri_check(char *uplo, integer *n, float *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPOTRI", &i__1); + xerbla_("SPOTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/ssygs2_check.c b/src/map/lapack2flamec/check/ssygs2_check.c index 871a28167..42f2e8957 100644 --- a/src/map/lapack2flamec/check/ssygs2_check.c +++ b/src/map/lapack2flamec/check/ssygs2_check.c @@ -16,12 +16,12 @@ int ssygs2_check(integer *itype, char *uplo, integer *n, float *a, integer *lda, b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -40,7 +40,7 @@ int ssygs2_check(integer *itype, char *uplo, integer *n, float *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGS2", &i__1); + xerbla_("SSYGS2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/ssygst_check.c b/src/map/lapack2flamec/check/ssygst_check.c index 42fbacf08..a2fb509b6 100644 --- a/src/map/lapack2flamec/check/ssygst_check.c +++ b/src/map/lapack2flamec/check/ssygst_check.c @@ -17,12 +17,12 @@ int ssygst_check(integer *itype, char *uplo, integer *n, float *a, integer *lda, b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -41,7 +41,7 @@ int ssygst_check(integer *itype, char *uplo, integer *n, float *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGST", &i__1); + xerbla_("SSYGST", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/ssytd2_check.c b/src/map/lapack2flamec/check/ssytd2_check.c index 85e5da8f9..8207e86a3 100644 --- a/src/map/lapack2flamec/check/ssytd2_check.c +++ b/src/map/lapack2flamec/check/ssytd2_check.c @@ -17,8 +17,8 @@ int ssytd2_check(char *uplo, integer *n, float *a, integer *lda, float *d__, flo --tau; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -33,7 +33,7 @@ int ssytd2_check(char *uplo, integer *n, float *a, integer *lda, float *d__, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTD2", &i__1); + xerbla_("SSYTD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/ssytrd_check.c b/src/map/lapack2flamec/check/ssytrd_check.c index cab9f8aa3..f1b699190 100644 --- a/src/map/lapack2flamec/check/ssytrd_check.c +++ b/src/map/lapack2flamec/check/ssytrd_check.c @@ -23,9 +23,9 @@ int ssytrd_check(char *uplo, integer *n, float *a, integer *lda, float *d__, flo --work; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; - if (! upper && ! lsame_(uplo, "L")) + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -51,7 +51,7 @@ int ssytrd_check(char *uplo, integer *n, float *a, integer *lda, float *d__, flo if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD", &i__1); + xerbla_("SSYTRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/strti2_check.c b/src/map/lapack2flamec/check/strti2_check.c index 86376ff0b..dbf1acdc2 100644 --- a/src/map/lapack2flamec/check/strti2_check.c +++ b/src/map/lapack2flamec/check/strti2_check.c @@ -15,13 +15,13 @@ int strti2_check(char *uplo, char *diag, integer *n, float *a, integer *lda, int a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -36,7 +36,7 @@ int strti2_check(char *uplo, char *diag, integer *n, float *a, integer *lda, int if (*info != 0) { i__1 = -(*info); - xerbla_("STRTI2", &i__1); + xerbla_("STRTI2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/strtri_check.c b/src/map/lapack2flamec/check/strtri_check.c index 7b2df12c2..9ade8c6b9 100644 --- a/src/map/lapack2flamec/check/strtri_check.c +++ b/src/map/lapack2flamec/check/strtri_check.c @@ -16,13 +16,13 @@ int strtri_check(char *uplo, char *diag, integer *n, float *a, integer *lda, int a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -37,7 +37,7 @@ int strtri_check(char *uplo, char *diag, integer *n, float *a, integer *lda, int if (*info != 0) { i__1 = -(*info); - xerbla_("STRTRI", &i__1); + xerbla_("STRTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zbdsqr_check.c b/src/map/lapack2flamec/check/zbdsqr_check.c index f2fb95e87..60d79382d 100644 --- a/src/map/lapack2flamec/check/zbdsqr_check.c +++ b/src/map/lapack2flamec/check/zbdsqr_check.c @@ -33,8 +33,8 @@ int zbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * --rwork; /* Function Body */ *info = 0; - lower = lsame_(uplo, "L"); - if (! lsame_(uplo, "U") && ! lower) + lower = lsame_(uplo, "L", 1, 1); + if (! lsame_(uplo, "U", 1, 1) && ! lower) { *info = -1; } @@ -69,7 +69,7 @@ int zbdsqr_check(char *uplo, integer *n, integer *ncvt, integer * nru, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZBDSQR", &i__1); + xerbla_("ZBDSQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*n == 0) diff --git a/src/map/lapack2flamec/check/zgebd2_check.c b/src/map/lapack2flamec/check/zgebd2_check.c index c7ec05239..8dbbd6ed7 100644 --- a/src/map/lapack2flamec/check/zgebd2_check.c +++ b/src/map/lapack2flamec/check/zgebd2_check.c @@ -32,7 +32,7 @@ int zgebd2_check(integer *m, integer *n, dcomplex *a, integer *lda, doublereal * if (*info < 0) { i__1 = -(*info); - xerbla_("ZGEBD2", &i__1); + xerbla_("ZGEBD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/zgebrd_check.c b/src/map/lapack2flamec/check/zgebrd_check.c index 47dc9d23b..13ca1caf4 100644 --- a/src/map/lapack2flamec/check/zgebrd_check.c +++ b/src/map/lapack2flamec/check/zgebrd_check.c @@ -60,7 +60,7 @@ int zgebrd_check(integer *m, integer *n, dcomplex *a, integer *lda, double *d__, if (*info < 0) { i__1 = -(*info); - xerbla_("ZGEBRD", &i__1); + xerbla_("ZGEBRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgehd2_check.c b/src/map/lapack2flamec/check/zgehd2_check.c index 39410dd26..c9b43e721 100644 --- a/src/map/lapack2flamec/check/zgehd2_check.c +++ b/src/map/lapack2flamec/check/zgehd2_check.c @@ -33,7 +33,7 @@ int zgehd2_check(integer *n, integer *ilo, integer *ihi, dcomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEHD2", &i__1); + xerbla_("ZGEHD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/zgehrd_check.c b/src/map/lapack2flamec/check/zgehrd_check.c index 3c4ef64d0..5e0d5ad4c 100644 --- a/src/map/lapack2flamec/check/zgehrd_check.c +++ b/src/map/lapack2flamec/check/zgehrd_check.c @@ -53,7 +53,7 @@ int zgehrd_check(integer *n, integer *ilo, integer *ihi, dcomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEHRD", &i__1); + xerbla_("ZGEHRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgelq2_check.c b/src/map/lapack2flamec/check/zgelq2_check.c index 68c8f7a90..e1c675fe8 100644 --- a/src/map/lapack2flamec/check/zgelq2_check.c +++ b/src/map/lapack2flamec/check/zgelq2_check.c @@ -29,7 +29,7 @@ int zgelq2_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQ2", &i__1); + xerbla_("ZGELQ2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/zgelqf_check.c b/src/map/lapack2flamec/check/zgelqf_check.c index a8e7412ad..2e3a20e23 100644 --- a/src/map/lapack2flamec/check/zgelqf_check.c +++ b/src/map/lapack2flamec/check/zgelqf_check.c @@ -44,7 +44,7 @@ int zgelqf_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQF", &i__1); + xerbla_("ZGELQF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgelsd_check.c b/src/map/lapack2flamec/check/zgelsd_check.c index 682ef65cf..560fe92a8 100644 --- a/src/map/lapack2flamec/check/zgelsd_check.c +++ b/src/map/lapack2flamec/check/zgelsd_check.c @@ -212,7 +212,7 @@ int zgelsd_check(integer *m, integer *n, integer *nrhs, dcomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSD", &i__1); + xerbla_("ZGELSD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgeqp3_check.c b/src/map/lapack2flamec/check/zgeqp3_check.c index fb79b5aa3..16736cea5 100644 --- a/src/map/lapack2flamec/check/zgeqp3_check.c +++ b/src/map/lapack2flamec/check/zgeqp3_check.c @@ -60,7 +60,7 @@ int zgeqp3_check(integer *m, integer *n, dcomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQP3", &i__1); + xerbla_("ZGEQP3", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgeqpf_check.c b/src/map/lapack2flamec/check/zgeqpf_check.c index 44547901a..616f50da5 100644 --- a/src/map/lapack2flamec/check/zgeqpf_check.c +++ b/src/map/lapack2flamec/check/zgeqpf_check.c @@ -37,7 +37,7 @@ int zgeqpf_check(integer *m, integer *n, dcomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQPF", &i__1); + xerbla_("ZGEQPF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zgeqr2_check.c b/src/map/lapack2flamec/check/zgeqr2_check.c index 9965dfa53..0aa8a31a0 100644 --- a/src/map/lapack2flamec/check/zgeqr2_check.c +++ b/src/map/lapack2flamec/check/zgeqr2_check.c @@ -29,7 +29,7 @@ int zgeqr2_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQR2", &i__1); + xerbla_("ZGEQR2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zgeqr2p_check.c b/src/map/lapack2flamec/check/zgeqr2p_check.c index cdb1c909f..0407f8681 100644 --- a/src/map/lapack2flamec/check/zgeqr2p_check.c +++ b/src/map/lapack2flamec/check/zgeqr2p_check.c @@ -29,7 +29,7 @@ int zgeqr2p_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *t if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQR2P", &i__1); + xerbla_("ZGEQR2P", &i__1, (ftnlen)7); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/zgeqrf_check.c b/src/map/lapack2flamec/check/zgeqrf_check.c index 53f706077..9aa540080 100644 --- a/src/map/lapack2flamec/check/zgeqrf_check.c +++ b/src/map/lapack2flamec/check/zgeqrf_check.c @@ -44,7 +44,7 @@ int zgeqrf_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRF", &i__1); + xerbla_("ZGEQRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgeqrfp_check.c b/src/map/lapack2flamec/check/zgeqrfp_check.c index 5b8a2d0e3..a8b73fae9 100644 --- a/src/map/lapack2flamec/check/zgeqrfp_check.c +++ b/src/map/lapack2flamec/check/zgeqrfp_check.c @@ -44,7 +44,7 @@ int zgeqrfp_check(integer *m, integer *n, dcomplex *a, integer *lda, dcomplex *t if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRFP", &i__1); + xerbla_("ZGEQRFP", &i__1, (ftnlen)7); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgesdd_check.c b/src/map/lapack2flamec/check/zgesdd_check.c index 8312967d8..3141da97f 100644 --- a/src/map/lapack2flamec/check/zgesdd_check.c +++ b/src/map/lapack2flamec/check/zgesdd_check.c @@ -35,11 +35,11 @@ int zgesdd_check(char *jobz, integer *m, integer *n, dcomplex *a, integer *lda, minmn = fla_min(*m,*n); mnthr1 = (integer) (minmn * 17. / 9.); mnthr2 = (integer) (minmn * 5. / 3.); - wntqa = lsame_(jobz, "A"); - wntqs = lsame_(jobz, "S"); + wntqa = lsame_(jobz, "A", 1, 1); + wntqs = lsame_(jobz, "S", 1, 1); wntqas = wntqa || wntqs; - wntqo = lsame_(jobz, "O"); - wntqn = lsame_(jobz, "N"); + wntqo = lsame_(jobz, "O", 1, 1); + wntqn = lsame_(jobz, "N", 1, 1); minwrk = 1; maxwrk = 1; if (! (wntqa || wntqs || wntqo || wntqn)) @@ -438,7 +438,7 @@ int zgesdd_check(char *jobz, integer *m, integer *n, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESDD", &i__1); + xerbla_("ZGESDD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } if (*lwork == -1) diff --git a/src/map/lapack2flamec/check/zgesvd_check.c b/src/map/lapack2flamec/check/zgesvd_check.c index dff4413e6..54537a43c 100644 --- a/src/map/lapack2flamec/check/zgesvd_check.c +++ b/src/map/lapack2flamec/check/zgesvd_check.c @@ -42,16 +42,16 @@ int zgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, dcomplex *a, i /* Function Body */ *info = 0; minmn = fla_min(*m,*n); - wntua = lsame_(jobu, "A"); - wntus = lsame_(jobu, "S"); + wntua = lsame_(jobu, "A", 1, 1); + wntus = lsame_(jobu, "S", 1, 1); wntuas = wntua || wntus; - wntuo = lsame_(jobu, "O"); - wntun = lsame_(jobu, "N"); - wntva = lsame_(jobvt, "A"); - wntvs = lsame_(jobvt, "S"); + wntuo = lsame_(jobu, "O", 1, 1); + wntun = lsame_(jobu, "N", 1, 1); + wntva = lsame_(jobvt, "A", 1, 1); + wntvs = lsame_(jobvt, "S", 1, 1); wntvas = wntva || wntvs; - wntvo = lsame_(jobvt, "O"); - wntvn = lsame_(jobvt, "N"); + wntvo = lsame_(jobvt, "O", 1, 1); + wntvn = lsame_(jobvt, "N", 1, 1); lquery = *lwork == -1; if (! (wntua || wntus || wntuo || wntun)) { @@ -615,7 +615,7 @@ int zgesvd_check(char *jobu, char *jobvt, integer *m, integer *n, dcomplex *a, i if (*info != 0) { i__2 = -(*info); - xerbla_("ZGESVD", &i__2); + xerbla_("ZGESVD", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zgetf2_check.c b/src/map/lapack2flamec/check/zgetf2_check.c index 026f05ed0..3378cd058 100644 --- a/src/map/lapack2flamec/check/zgetf2_check.c +++ b/src/map/lapack2flamec/check/zgetf2_check.c @@ -28,7 +28,7 @@ int zgetf2_check(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETF2", &i__1); + xerbla_("ZGETF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zgetrf_check.c b/src/map/lapack2flamec/check/zgetrf_check.c index a7dcdc5e3..682ade515 100644 --- a/src/map/lapack2flamec/check/zgetrf_check.c +++ b/src/map/lapack2flamec/check/zgetrf_check.c @@ -27,7 +27,7 @@ int zgetrf_check(integer *m, integer *n, dcomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRF", &i__1); + xerbla_("ZGETRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zgetrfnp_check.c b/src/map/lapack2flamec/check/zgetrfnp_check.c index 079937b86..54842878e 100644 --- a/src/map/lapack2flamec/check/zgetrfnp_check.c +++ b/src/map/lapack2flamec/check/zgetrfnp_check.c @@ -30,7 +30,7 @@ int zgetrfnp_check(integer *m, integer *n, dcomplex *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRFNP", &i__1); + xerbla_("ZGETRFNP", &i__1, (ftnlen)8); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zgetrfnpi_check.c b/src/map/lapack2flamec/check/zgetrfnpi_check.c index 09dfff42a..1b93a39ac 100644 --- a/src/map/lapack2flamec/check/zgetrfnpi_check.c +++ b/src/map/lapack2flamec/check/zgetrfnpi_check.c @@ -34,7 +34,7 @@ int zgetrfnpi_check(integer *m, integer *n, integer *nfact, dcomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRFNPI", &i__1); + xerbla_("ZGETRFNPI", &i__1, (ftnlen)9); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zhegs2_check.c b/src/map/lapack2flamec/check/zhegs2_check.c index 26cf7e724..18e20e9dd 100644 --- a/src/map/lapack2flamec/check/zhegs2_check.c +++ b/src/map/lapack2flamec/check/zhegs2_check.c @@ -16,12 +16,12 @@ int zhegs2_check(integer *itype, char *uplo, integer *n, dcomplex *a, integer *l b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -40,7 +40,7 @@ int zhegs2_check(integer *itype, char *uplo, integer *n, dcomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGS2", &i__1); + xerbla_("ZHEGS2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/zhegst_check.c b/src/map/lapack2flamec/check/zhegst_check.c index fb4790998..312764992 100644 --- a/src/map/lapack2flamec/check/zhegst_check.c +++ b/src/map/lapack2flamec/check/zhegst_check.c @@ -17,12 +17,12 @@ int zhegst_check(integer *itype, char *uplo, integer *n, dcomplex *a, integer *l b -= b_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); if (*itype < 1 || *itype > 3) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } @@ -41,7 +41,7 @@ int zhegst_check(integer *itype, char *uplo, integer *n, dcomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGST", &i__1); + xerbla_("ZHEGST", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zhetd2_check.c b/src/map/lapack2flamec/check/zhetd2_check.c index b22111038..235becce4 100644 --- a/src/map/lapack2flamec/check/zhetd2_check.c +++ b/src/map/lapack2flamec/check/zhetd2_check.c @@ -16,8 +16,8 @@ int zhetd2_check(char *uplo, integer *n, dcomplex *a, integer *lda, double *d__, --tau; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -32,7 +32,7 @@ int zhetd2_check(char *uplo, integer *n, dcomplex *a, integer *lda, double *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETD2", &i__1); + xerbla_("ZHETD2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zhetrd_check.c b/src/map/lapack2flamec/check/zhetrd_check.c index 8f7e9b959..915edbc0e 100644 --- a/src/map/lapack2flamec/check/zhetrd_check.c +++ b/src/map/lapack2flamec/check/zhetrd_check.c @@ -23,9 +23,9 @@ int zhetrd_check(char *uplo, integer *n, dcomplex *a, integer *lda, double *d__, --work; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; - if (! upper && ! lsame_(uplo, "L")) + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -52,7 +52,7 @@ int zhetrd_check(char *uplo, integer *n, dcomplex *a, integer *lda, double *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD", &i__1); + xerbla_("ZHETRD", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zlauu2_check.c b/src/map/lapack2flamec/check/zlauu2_check.c index 45f381ca7..70a15d580 100644 --- a/src/map/lapack2flamec/check/zlauu2_check.c +++ b/src/map/lapack2flamec/check/zlauu2_check.c @@ -15,8 +15,8 @@ int zlauu2_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -31,7 +31,7 @@ int zlauu2_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAUU2", &i__1); + xerbla_("ZLAUU2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zlauum_check.c b/src/map/lapack2flamec/check/zlauum_check.c index 2b5eaf74e..8ad7fd5a3 100644 --- a/src/map/lapack2flamec/check/zlauum_check.c +++ b/src/map/lapack2flamec/check/zlauum_check.c @@ -15,8 +15,8 @@ int zlauum_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -31,7 +31,7 @@ int zlauum_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAUUM", &i__1); + xerbla_("ZLAUUM", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zpotf2_check.c b/src/map/lapack2flamec/check/zpotf2_check.c index f4a63ed54..510e61b88 100644 --- a/src/map/lapack2flamec/check/zpotf2_check.c +++ b/src/map/lapack2flamec/check/zpotf2_check.c @@ -15,8 +15,8 @@ int zpotf2_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -31,7 +31,7 @@ int zpotf2_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOTF2", &i__1); + xerbla_("ZPOTF2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zpotrf_check.c b/src/map/lapack2flamec/check/zpotrf_check.c index 51e6ca61a..b86878ff6 100644 --- a/src/map/lapack2flamec/check/zpotrf_check.c +++ b/src/map/lapack2flamec/check/zpotrf_check.c @@ -14,8 +14,8 @@ int zpotrf_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -30,7 +30,7 @@ int zpotrf_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOTRF", &i__1); + xerbla_("ZPOTRF", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zpotri_check.c b/src/map/lapack2flamec/check/zpotri_check.c index 442e878f5..67f0dedc2 100644 --- a/src/map/lapack2flamec/check/zpotri_check.c +++ b/src/map/lapack2flamec/check/zpotri_check.c @@ -18,7 +18,7 @@ int zpotri_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf a -= a_offset; /* Function Body */ *info = 0; - if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) + if (! lsame_(uplo, "U", 1, 1) && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -33,7 +33,7 @@ int zpotri_check(char *uplo, integer *n, dcomplex *a, integer *lda, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOTRI", &i__1); + xerbla_("ZPOTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/ztrti2_check.c b/src/map/lapack2flamec/check/ztrti2_check.c index 9a5db7e3f..9a7109e6f 100644 --- a/src/map/lapack2flamec/check/ztrti2_check.c +++ b/src/map/lapack2flamec/check/ztrti2_check.c @@ -16,13 +16,13 @@ int ztrti2_check(char *uplo, char *diag, integer *n, dcomplex *a, integer *lda, a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -37,7 +37,7 @@ int ztrti2_check(char *uplo, char *diag, integer *n, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRTI2", &i__1); + xerbla_("ZTRTI2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } return LAPACK_SUCCESS; diff --git a/src/map/lapack2flamec/check/ztrtri_check.c b/src/map/lapack2flamec/check/ztrtri_check.c index e17251c5d..f6139d73f 100644 --- a/src/map/lapack2flamec/check/ztrtri_check.c +++ b/src/map/lapack2flamec/check/ztrtri_check.c @@ -16,13 +16,13 @@ int ztrtri_check(char *uplo, char *diag, integer *n, dcomplex *a, integer *lda, a -= a_offset; /* Function Body */ *info = 0; - upper = lsame_(uplo, "U"); - nounit = lsame_(diag, "N"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + nounit = lsame_(diag, "N", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } - else if (! nounit && ! lsame_(diag, "U")) + else if (! nounit && ! lsame_(diag, "U", 1, 1)) { *info = -2; } @@ -37,7 +37,7 @@ int ztrtri_check(char *uplo, char *diag, integer *n, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRTRI", &i__1); + xerbla_("ZTRTRI", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zung2r_check.c b/src/map/lapack2flamec/check/zung2r_check.c index 7ea2c6355..068647692 100644 --- a/src/map/lapack2flamec/check/zung2r_check.c +++ b/src/map/lapack2flamec/check/zung2r_check.c @@ -33,7 +33,7 @@ int zung2r_check(integer *m, integer *n, integer *k, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNG2R", &i__1); + xerbla_("ZUNG2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zungbr_check.c b/src/map/lapack2flamec/check/zungbr_check.c index f472b21cd..14544d614 100644 --- a/src/map/lapack2flamec/check/zungbr_check.c +++ b/src/map/lapack2flamec/check/zungbr_check.c @@ -32,10 +32,10 @@ int zungbr_check(char *vect, integer *m, integer *n, integer *k, dcomplex *a, in --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "Q"); + wantq = lsame_(vect, "Q", 1, 1); mn = fla_min(*m,*n); lquery = *lwork == -1; - if (! wantq && ! lsame_(vect, "P")) + if (! wantq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } @@ -103,7 +103,7 @@ int zungbr_check(char *vect, integer *m, integer *n, integer *k, dcomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGBR", &i__1); + xerbla_("ZUNGBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zungl2_check.c b/src/map/lapack2flamec/check/zungl2_check.c index 64587517b..f9d19653e 100644 --- a/src/map/lapack2flamec/check/zungl2_check.c +++ b/src/map/lapack2flamec/check/zungl2_check.c @@ -33,7 +33,7 @@ int zungl2_check(integer *m, integer *n, integer *k, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGL2", &i__1); + xerbla_("ZUNGL2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zunglq_check.c b/src/map/lapack2flamec/check/zunglq_check.c index cb719efec..598079254 100644 --- a/src/map/lapack2flamec/check/zunglq_check.c +++ b/src/map/lapack2flamec/check/zunglq_check.c @@ -49,7 +49,7 @@ int zunglq_check(integer *m, integer *n, integer *k, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGLQ", &i__1); + xerbla_("ZUNGLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zungqr_check.c b/src/map/lapack2flamec/check/zungqr_check.c index 74174ef67..c09403823 100644 --- a/src/map/lapack2flamec/check/zungqr_check.c +++ b/src/map/lapack2flamec/check/zungqr_check.c @@ -49,7 +49,7 @@ int zungqr_check(integer *m, integer *n, integer *k, dcomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGQR", &i__1); + xerbla_("ZUNGQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zungtr_check.c b/src/map/lapack2flamec/check/zungtr_check.c index 823d80c2d..5b3c1a7b5 100644 --- a/src/map/lapack2flamec/check/zungtr_check.c +++ b/src/map/lapack2flamec/check/zungtr_check.c @@ -22,8 +22,8 @@ int zungtr_check(char *uplo, integer *n, dcomplex *a, integer *lda, dcomplex *ta /* Function Body */ *info = 0; lquery = *lwork == -1; - upper = lsame_(uplo, "U"); - if (! upper && ! lsame_(uplo, "L")) + upper = lsame_(uplo, "U", 1, 1); + if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -1; } @@ -71,7 +71,7 @@ int zungtr_check(char *uplo, integer *n, dcomplex *a, integer *lda, dcomplex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGTR", &i__1); + xerbla_("ZUNGTR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zunm2r_check.c b/src/map/lapack2flamec/check/zunm2r_check.c index 22eac0f64..e33cfa219 100644 --- a/src/map/lapack2flamec/check/zunm2r_check.c +++ b/src/map/lapack2flamec/check/zunm2r_check.c @@ -22,8 +22,8 @@ int zunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, dc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -33,11 +33,11 @@ int zunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, dc { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -64,7 +64,7 @@ int zunm2r_check(char *side, char *trans, integer *m, integer *n, integer *k, dc if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNM2R", &i__1); + xerbla_("ZUNM2R", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zunmbr_check.c b/src/map/lapack2flamec/check/zunmbr_check.c index 1daf43cc3..f82eb56fe 100644 --- a/src/map/lapack2flamec/check/zunmbr_check.c +++ b/src/map/lapack2flamec/check/zunmbr_check.c @@ -27,9 +27,9 @@ int zunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in --work; /* Function Body */ *info = 0; - applyq = lsame_(vect, "Q"); - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + applyq = lsame_(vect, "Q", 1, 1); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q or P and NW is the minimum dimension of WORK */ if (left) @@ -46,15 +46,15 @@ int zunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in { nw = 0; } - if (! applyq && ! lsame_(vect, "P")) + if (! applyq && ! lsame_(vect, "P", 1, 1)) { *info = -1; } - else if (! left && ! lsame_(side, "R")) + else if (! left && ! lsame_(side, "R", 1, 1)) { *info = -2; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -3; } @@ -137,7 +137,7 @@ int zunmbr_check(char *vect, char *side, char *trans, integer *m, integer *n, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMBR", &i__1); + xerbla_("ZUNMBR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zunml2_check.c b/src/map/lapack2flamec/check/zunml2_check.c index bc4e858d7..e3d6ef550 100644 --- a/src/map/lapack2flamec/check/zunml2_check.c +++ b/src/map/lapack2flamec/check/zunml2_check.c @@ -22,8 +22,8 @@ int zunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, dc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); /* NQ is the order of Q */ if (left) { @@ -33,11 +33,11 @@ int zunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, dc { nq = *n; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -64,7 +64,7 @@ int zunml2_check(char *side, char *trans, integer *m, integer *n, integer *k, dc if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNML2", &i__1); + xerbla_("ZUNML2", &i__1, (ftnlen)6); return LAPACK_FAILURE; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/check/zunmlq_check.c b/src/map/lapack2flamec/check/zunmlq_check.c index f9569024e..cbacb78b7 100644 --- a/src/map/lapack2flamec/check/zunmlq_check.c +++ b/src/map/lapack2flamec/check/zunmlq_check.c @@ -27,8 +27,8 @@ int zunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, dc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int zunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, dc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -88,7 +88,7 @@ int zunmlq_check(char *side, char *trans, integer *m, integer *n, integer *k, dc if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMLQ", &i__1); + xerbla_("ZUNMLQ", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zunmqr_check.c b/src/map/lapack2flamec/check/zunmqr_check.c index 6622c4abe..42a28143e 100644 --- a/src/map/lapack2flamec/check/zunmqr_check.c +++ b/src/map/lapack2flamec/check/zunmqr_check.c @@ -27,8 +27,8 @@ int zunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, dc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - notran = lsame_(trans, "N"); + left = lsame_(side, "L", 1, 1); + notran = lsame_(trans, "N", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -41,11 +41,11 @@ int zunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, dc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! notran && ! lsame_(trans, "C")) + else if (! notran && ! lsame_(trans, "C", 1, 1)) { *info = -2; } @@ -88,7 +88,7 @@ int zunmqr_check(char *side, char *trans, integer *m, integer *n, integer *k, dc if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMQR", &i__1); + xerbla_("ZUNMQR", &i__1, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/check/zunmtr_check.c b/src/map/lapack2flamec/check/zunmtr_check.c index 9ada51257..1b599c31c 100644 --- a/src/map/lapack2flamec/check/zunmtr_check.c +++ b/src/map/lapack2flamec/check/zunmtr_check.c @@ -26,8 +26,8 @@ int zunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, dc --work; /* Function Body */ *info = 0; - left = lsame_(side, "L"); - upper = lsame_(uplo, "U"); + left = lsame_(side, "L", 1, 1); + upper = lsame_(uplo, "U", 1, 1); lquery = *lwork == -1; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) @@ -40,15 +40,15 @@ int zunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, dc nq = *n; nw = *m; } - if (! left && ! lsame_(side, "R")) + if (! left && ! lsame_(side, "R", 1, 1)) { *info = -1; } - else if (! upper && ! lsame_(uplo, "L")) + else if (! upper && ! lsame_(uplo, "L", 1, 1)) { *info = -2; } - else if (! lsame_(trans, "N") && ! lsame_(trans, "C")) + else if (! lsame_(trans, "N", 1, 1) && ! lsame_(trans, "C", 1, 1)) { *info = -3; } @@ -111,7 +111,7 @@ int zunmtr_check(char *side, char *uplo, char *trans, integer *m, integer *n, dc if (*info != 0) { i__2 = -(*info); - xerbla_("ZUNMTR", &i__2); + xerbla_("ZUNMTR", &i__2, (ftnlen)6); return LAPACK_FAILURE; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/cbbcsd.c b/src/map/lapack2flamec/f2c/c/cbbcsd.c index 971965799..771230932 100644 --- a/src/map/lapack2flamec/f2c/c/cbbcsd.c +++ b/src/map/lapack2flamec/f2c/c/cbbcsd.c @@ -371,7 +371,7 @@ int cbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, real sigma11, sigma21; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real thresh, tolmul; logical lquery; real b11bulge, b12bulge; @@ -492,7 +492,7 @@ int cbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("CBBCSD", &i__1); + xerbla_("CBBCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cbdsqr.c b/src/map/lapack2flamec/f2c/c/cbdsqr.c index 5146bb6b2..886e05e28 100644 --- a/src/map/lapack2flamec/f2c/c/cbdsqr.c +++ b/src/map/lapack2flamec/f2c/c/cbdsqr.c @@ -267,7 +267,7 @@ int cbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, int csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *), slasq1_(integer *, real *, real *, real *, integer *), slasv2_(real *, real *, real *, real *, real *, real *, real *, real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real sminoa; extern /* Subroutine */ int slartg_(real *, real *, real *, real *, real * ); @@ -346,7 +346,7 @@ int cbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, if (*info != 0) { i__1 = -(*info); - xerbla_("CBDSQR", &i__1); + xerbla_("CBDSQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbbrd.c b/src/map/lapack2flamec/f2c/c/cgbbrd.c index 6633a1e3b..eb62fcded 100644 --- a/src/map/lapack2flamec/f2c/c/cgbbrd.c +++ b/src/map/lapack2flamec/f2c/c/cgbbrd.c @@ -231,7 +231,7 @@ int cgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ integer minmn; logical wantq; extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(char *, integer *), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *), clartv_(integer *, complex *, integer *, complex *, integer *, real *, complex *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *), clartv_(integer *, complex *, integer *, complex *, integer *, real *, complex *, integer *); logical wantpt; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -321,7 +321,7 @@ int cgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBBRD", &i__1); + xerbla_("CGBBRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbcon.c b/src/map/lapack2flamec/f2c/c/cgbcon.c index a226dc9e7..92c914b2b 100644 --- a/src/map/lapack2flamec/f2c/c/cgbcon.c +++ b/src/map/lapack2flamec/f2c/c/cgbcon.c @@ -171,7 +171,7 @@ int cgbcon_(char *norm, integer *n, integer *kl, integer *ku, complex *ab, integ extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clatbs_(char *, char *, char *, char *, integer *, integer *, complex *, integer *, complex *, real *, real *, integer *), xerbla_(char *, integer *); + int clatbs_(char *, char *, char *, char *, integer *, integer *, complex *, integer *, complex *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csrscl_(integer *, real *, complex *, integer *); @@ -242,7 +242,7 @@ int cgbcon_(char *norm, integer *n, integer *kl, integer *ku, complex *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBCON", &i__1); + xerbla_("CGBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbequ.c b/src/map/lapack2flamec/f2c/c/cgbequ.c index f580efbf1..504a7274c 100644 --- a/src/map/lapack2flamec/f2c/c/cgbequ.c +++ b/src/map/lapack2flamec/f2c/c/cgbequ.c @@ -161,7 +161,7 @@ int cgbequ_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ real rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -219,7 +219,7 @@ int cgbequ_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBEQU", &i__1); + xerbla_("CGBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbequb.c b/src/map/lapack2flamec/f2c/c/cgbequb.c index a59b38283..099323123 100644 --- a/src/map/lapack2flamec/f2c/c/cgbequb.c +++ b/src/map/lapack2flamec/f2c/c/cgbequb.c @@ -168,7 +168,7 @@ int cgbequb_(integer *m, integer *n, integer *kl, integer * ku, complex *ab, int real radix, rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -226,7 +226,7 @@ int cgbequb_(integer *m, integer *n, integer *kl, integer * ku, complex *ab, int if (*info != 0) { i__1 = -(*info); - xerbla_("CGBEQUB", &i__1); + xerbla_("CGBEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbrfs.c b/src/map/lapack2flamec/f2c/c/cgbrfs.c index e04861a5b..f19a249a8 100644 --- a/src/map/lapack2flamec/f2c/c/cgbrfs.c +++ b/src/map/lapack2flamec/f2c/c/cgbrfs.c @@ -236,7 +236,7 @@ int cgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, c extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); logical notran; char transn[1], transt[1]; real lstres; @@ -327,7 +327,7 @@ int cgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGBRFS", &i__1); + xerbla_("CGBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbrfsx.c b/src/map/lapack2flamec/f2c/c/cgbrfsx.c index 658aa6b28..a53dd0e64 100644 --- a/src/map/lapack2flamec/f2c/c/cgbrfsx.c +++ b/src/map/lapack2flamec/f2c/c/cgbrfsx.c @@ -473,7 +473,7 @@ int cgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in int cgbcon_(char *, integer *, integer *, integer *, complex *, integer *, integer *, real *, real *, complex *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -634,7 +634,7 @@ int cgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in if (*info != 0) { i__1 = -(*info); - xerbla_("CGBRFSX", &i__1); + xerbla_("CGBRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbsv.c b/src/map/lapack2flamec/f2c/c/cgbsv.c index 236164ffe..effd12bd1 100644 --- a/src/map/lapack2flamec/f2c/c/cgbsv.c +++ b/src/map/lapack2flamec/f2c/c/cgbsv.c @@ -167,7 +167,7 @@ int cgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, complex *ab, in integer ab_dim1, ab_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), xerbla_( char *, integer *), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -220,7 +220,7 @@ int cgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, complex *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("CGBSV ", &i__1); + xerbla_("CGBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbsvx.c b/src/map/lapack2flamec/f2c/c/cgbsvx.c index d1d6a7370..56c6162fc 100644 --- a/src/map/lapack2flamec/f2c/c/cgbsvx.c +++ b/src/map/lapack2flamec/f2c/c/cgbsvx.c @@ -402,7 +402,7 @@ int cgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ int cgbrfs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -461,6 +461,8 @@ int cgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -592,7 +594,7 @@ int cgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBSVX", &i__1); + xerbla_("CGBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbsvxx.c b/src/map/lapack2flamec/f2c/c/cgbsvxx.c index 847ab5e94..c2f190f55 100644 --- a/src/map/lapack2flamec/f2c/c/cgbsvxx.c +++ b/src/map/lapack2flamec/f2c/c/cgbsvxx.c @@ -589,7 +589,7 @@ int cgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int int cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -787,7 +787,7 @@ int cgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int if (*info != 0) { i__1 = -(*info); - xerbla_("CGBSVXX", &i__1); + xerbla_("CGBSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgbtf2.c b/src/map/lapack2flamec/f2c/c/cgbtf2.c index be2c72460..27492f974 100644 --- a/src/map/lapack2flamec/f2c/c/cgbtf2.c +++ b/src/map/lapack2flamec/f2c/c/cgbtf2.c @@ -164,7 +164,7 @@ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ int cscal_(integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_( integer *, complex *, integer *, complex *, integer *); extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -223,7 +223,7 @@ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBTF2", &i__1); + xerbla_("CGBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -234,7 +234,7 @@ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -271,11 +271,11 @@ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ if(j%32==0 || j==i__1){ - step_count=j; - AOCL_FLA_PROGRESS_FUNC_PTR("CGBTF2",6,&step_count,&thread_id,&total_threads); + progress_step_count = j; + AOCL_FLA_PROGRESS_FUNC_PTR("CGBTF2",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } } - #endif + #endif /* Set fill-in elements in column J+KV to zero. */ if (j + kv <= *n) diff --git a/src/map/lapack2flamec/f2c/c/cgbtrf.c b/src/map/lapack2flamec/f2c/c/cgbtrf.c index 8f331a361..aa9c4cfe1 100644 --- a/src/map/lapack2flamec/f2c/c/cgbtrf.c +++ b/src/map/lapack2flamec/f2c/c/cgbtrf.c @@ -170,7 +170,7 @@ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), cgbtf2_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *); extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); @@ -234,7 +234,7 @@ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGBTRF", &i__1); + xerbla_("CGBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -245,7 +245,7 @@ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -335,11 +335,11 @@ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku, complex *ab, integ jb = fla_min(i__3,i__4); #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("CGBTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("CGBTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } - #endif + #endif /* The active part of the matrix is partitioned */ /* A11 A12 A13 */ diff --git a/src/map/lapack2flamec/f2c/c/cgbtrs.c b/src/map/lapack2flamec/f2c/c/cgbtrs.c index 4b2d86c68..545572512 100644 --- a/src/map/lapack2flamec/f2c/c/cgbtrs.c +++ b/src/map/lapack2flamec/f2c/c/cgbtrs.c @@ -153,7 +153,7 @@ int cgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, c int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *), ctbsv_(char *, char *, char *, integer *, integer *, complex *, integer *, complex *, integer *); logical lnoti; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -218,7 +218,7 @@ int cgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGBTRS", &i__1); + xerbla_("CGBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgebak.c b/src/map/lapack2flamec/f2c/c/cgebak.c index 3309772a6..eb33b0c76 100644 --- a/src/map/lapack2flamec/f2c/c/cgebak.c +++ b/src/map/lapack2flamec/f2c/c/cgebak.c @@ -135,7 +135,7 @@ int cgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real int cswap_(integer *, complex *, integer *, complex *, integer *); logical leftv; extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -197,7 +197,7 @@ int cgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real if (*info != 0) { i__1 = -(*info); - xerbla_("CGEBAK", &i__1); + xerbla_("CGEBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgebal.c b/src/map/lapack2flamec/f2c/c/cgebal.c index ba033ed66..1e20a051d 100644 --- a/src/map/lapack2flamec/f2c/c/cgebal.c +++ b/src/map/lapack2flamec/f2c/c/cgebal.c @@ -183,7 +183,7 @@ int cgebal_(char *job, integer *n, complex *a, integer *lda, integer *ilo, integ extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern logical sisnan_(real *); logical noconv; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -227,7 +227,7 @@ int cgebal_(char *job, integer *n, complex *a, integer *lda, integer *ilo, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CGEBAL", &i__1); + xerbla_("CGEBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -398,7 +398,7 @@ int cgebal_(char *job, integer *n, complex *a, integer *lda, integer *ilo, integ /* Exit if NaN to avoid infinite loop */ *info = -3; i__2 = -(*info); - xerbla_("CGEBAL", &i__2); + xerbla_("CGEBAL", &i__2, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgebd2.c b/src/map/lapack2flamec/f2c/c/cgebd2.c index 1dd923971..1a3cf8c8a 100644 --- a/src/map/lapack2flamec/f2c/c/cgebd2.c +++ b/src/map/lapack2flamec/f2c/c/cgebd2.c @@ -210,7 +210,7 @@ int cgebd2_(integer *m, integer *n, complex *a, integer *lda, real *d__, real *e integer i__; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -256,7 +256,7 @@ int cgebd2_(integer *m, integer *n, complex *a, integer *lda, real *d__, real *e if (*info < 0) { i__1 = -(*info); - xerbla_("CGEBD2", &i__1); + xerbla_("CGEBD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgebrd.c b/src/map/lapack2flamec/f2c/c/cgebrd.c index a0c24b150..8364a7ec3 100644 --- a/src/map/lapack2flamec/f2c/c/cgebrd.c +++ b/src/map/lapack2flamec/f2c/c/cgebrd.c @@ -235,7 +235,7 @@ int cgebrd_(integer *m, integer *n, complex *a, integer *lda, real *d__, real *e int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer nbmin, iinfo, minmn; extern /* Subroutine */ - int cgebd2_(integer *, integer *, complex *, integer *, real *, real *, complex *, complex *, complex *, integer *), clabrd_(integer *, integer *, integer *, complex *, integer *, real *, real *, complex *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int cgebd2_(integer *, integer *, complex *, integer *, real *, real *, complex *, complex *, complex *, integer *), clabrd_(integer *, integer *, integer *, complex *, integer *, real *, real *, complex *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwrkx, ldwrky, lwkopt; logical lquery; @@ -304,7 +304,7 @@ int cgebrd_(integer *m, integer *n, complex *a, integer *lda, real *d__, real *e if (*info < 0) { i__1 = -(*info); - xerbla_("CGEBRD", &i__1); + xerbla_("CGEBRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgecon.c b/src/map/lapack2flamec/f2c/c/cgecon.c index fae46ec00..7989aad78 100644 --- a/src/map/lapack2flamec/f2c/c/cgecon.c +++ b/src/map/lapack2flamec/f2c/c/cgecon.c @@ -142,7 +142,7 @@ int cgecon_(char *norm, integer *n, complex *a, integer *lda, real *anorm, real extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *), csrscl_(integer *, real *, complex *, integer *); @@ -204,7 +204,7 @@ int cgecon_(char *norm, integer *n, complex *a, integer *lda, real *anorm, real if (*info != 0) { i__1 = -(*info); - xerbla_("CGECON", &i__1); + xerbla_("CGECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeequ.c b/src/map/lapack2flamec/f2c/c/cgeequ.c index bb4bcf998..e0b5a46bd 100644 --- a/src/map/lapack2flamec/f2c/c/cgeequ.c +++ b/src/map/lapack2flamec/f2c/c/cgeequ.c @@ -147,7 +147,7 @@ int cgeequ_(integer *m, integer *n, complex *a, integer *lda, real *r__, real *c real rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -197,7 +197,7 @@ int cgeequ_(integer *m, integer *n, complex *a, integer *lda, real *r__, real *c if (*info != 0) { i__1 = -(*info); - xerbla_("CGEEQU", &i__1); + xerbla_("CGEEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeequb.c b/src/map/lapack2flamec/f2c/c/cgeequb.c index cab425e57..f1e23d268 100644 --- a/src/map/lapack2flamec/f2c/c/cgeequb.c +++ b/src/map/lapack2flamec/f2c/c/cgeequb.c @@ -154,7 +154,7 @@ int cgeequb_(integer *m, integer *n, complex *a, integer * lda, real *r__, real real radix, rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -204,7 +204,7 @@ int cgeequb_(integer *m, integer *n, complex *a, integer * lda, real *r__, real if (*info != 0) { i__1 = -(*info); - xerbla_("CGEEQUB", &i__1); + xerbla_("CGEEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgees.c b/src/map/lapack2flamec/f2c/c/cgees.c index 7069a3063..04d1eabd0 100644 --- a/src/map/lapack2flamec/f2c/c/cgees.c +++ b/src/map/lapack2flamec/f2c/c/cgees.c @@ -191,7 +191,7 @@ elements 1:ILO-1 and i+1:N of W */ /* > \ingroup complexGEeigen */ /* ===================================================================== */ /* Subroutine */ -int cgees_(char *jobvs, char *sort, L_fp select, integer *n, complex *a, integer *lda, integer *sdim, complex *w, complex *vs, integer *ldvs, complex *work, integer *lwork, real *rwork, logical * bwork, integer *info) +int cgees_(char *jobvs, char *sort, L_fp1 select, integer *n, complex *a, integer *lda, integer *sdim, complex *w, complex *vs, integer *ldvs, complex *work, integer *lwork, real *rwork, logical * bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cgees inputs: jobvs %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *n, *lda, *ldvs); @@ -217,7 +217,7 @@ int cgees_(char *jobvs, char *sort, L_fp select, integer *n, complex *a, integer int cgehrd_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -332,7 +332,7 @@ int cgees_(char *jobvs, char *sort, L_fp select, integer *n, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGEES ", &i__1); + xerbla_("CGEES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeesx.c b/src/map/lapack2flamec/f2c/c/cgeesx.c index 57fbd5727..fd4b92ff8 100644 --- a/src/map/lapack2flamec/f2c/c/cgeesx.c +++ b/src/map/lapack2flamec/f2c/c/cgeesx.c @@ -237,7 +237,7 @@ if */ /* > \ingroup complexGEeigen */ /* ===================================================================== */ /* Subroutine */ -int cgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, complex *a, integer *lda, integer *sdim, complex * w, complex *vs, integer *ldvs, real *rconde, real *rcondv, complex * work, integer *lwork, real *rwork, logical *bwork, integer *info) +int cgeesx_(char *jobvs, char *sort, L_fp1 select, char * sense, integer *n, complex *a, integer *lda, integer *sdim, complex * w, complex *vs, integer *ldvs, real *rconde, real *rcondv, complex * work, integer *lwork, real *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cgeesx inputs: jobvs %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *sense, *n, *lda, *ldvs); @@ -261,7 +261,7 @@ int cgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, comp int cgehrd_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -319,6 +319,7 @@ int cgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, comp wantsv = lsame_(sense, "V"); wantsb = lsame_(sense, "B"); lquery = *lwork == -1; + maxwrk = 0; if (! wantvs && ! lsame_(jobvs, "N")) { *info = -1; @@ -400,7 +401,7 @@ int cgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGEESX", &i__1); + xerbla_("CGEESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeev.c b/src/map/lapack2flamec/f2c/c/cgeev.c index 212c9c99f..f95e58ff5 100644 --- a/src/map/lapack2flamec/f2c/c/cgeev.c +++ b/src/map/lapack2flamec/f2c/c/cgeev.c @@ -215,7 +215,7 @@ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl int cgehrd_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; real bignum; @@ -362,7 +362,7 @@ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CGEEV ", &i__1); + xerbla_("CGEEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeevx.c b/src/map/lapack2flamec/f2c/c/cgeevx.c index bf52cebb5..6b66640af 100644 --- a/src/map/lapack2flamec/f2c/c/cgeevx.c +++ b/src/map/lapack2flamec/f2c/c/cgeevx.c @@ -327,7 +327,7 @@ int cgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, co int cgehrd_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; real bignum; @@ -528,7 +528,7 @@ int cgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGEEVX", &i__1); + xerbla_("CGEEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgegs.c b/src/map/lapack2flamec/f2c/c/cgegs.c index d7e806511..228c702e4 100644 --- a/src/map/lapack2flamec/f2c/c/cgegs.c +++ b/src/map/lapack2flamec/f2c/c/cgegs.c @@ -263,7 +263,7 @@ int cgegs_(char *jobvsl, char *jobvsr, integer *n, complex * a, integer *lda, co int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -402,7 +402,7 @@ int cgegs_(char *jobvsl, char *jobvsr, integer *n, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGEGS ", &i__1); + xerbla_("CGEGS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgegv.c b/src/map/lapack2flamec/f2c/c/cgegv.c index 807810401..7e892bcc3 100644 --- a/src/map/lapack2flamec/f2c/c/cgegv.c +++ b/src/map/lapack2flamec/f2c/c/cgegv.c @@ -334,7 +334,7 @@ int cgegv_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl char chtemp[1]; logical ldumma[1]; extern /* Subroutine */ - int chgeqz_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), xerbla_(char *, integer *); + int chgeqz_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ijobvl, iright; logical ilimit; @@ -481,7 +481,7 @@ int cgegv_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CGEGV ", &i__1); + xerbla_("CGEGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgehd2.c b/src/map/lapack2flamec/f2c/c/cgehd2.c index 75d6ee8ea..80431896f 100644 --- a/src/map/lapack2flamec/f2c/c/cgehd2.c +++ b/src/map/lapack2flamec/f2c/c/cgehd2.c @@ -158,7 +158,7 @@ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c integer i__; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGEHD2", &i__1); + xerbla_("CGEHD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgehrd.c b/src/map/lapack2flamec/f2c/c/cgehrd.c index dc8256342..5286fb762 100644 --- a/src/map/lapack2flamec/f2c/c/cgehrd.c +++ b/src/map/lapack2flamec/f2c/c/cgehrd.c @@ -191,7 +191,7 @@ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer nbmin, iinfo; extern /* Subroutine */ - int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), cgehd2_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clahr2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), cgehd2_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clahr2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -225,6 +225,7 @@ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c /* Function Body */ *info = 0; lquery = *lwork == -1; + nx = 0; if (*n < 0) { *info = -1; @@ -259,7 +260,7 @@ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGEHRD", &i__1); + xerbla_("CGEHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgejsv.c b/src/map/lapack2flamec/f2c/c/cgejsv.c index 95ab76e1c..b4d85535d 100644 --- a/src/map/lapack2flamec/f2c/c/cgejsv.c +++ b/src/map/lapack2flamec/f2c/c/cgejsv.c @@ -646,7 +646,7 @@ int cgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ - int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cpocon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), csscal_(integer *, real *, complex *, integer *), classq_(integer *, complex *, integer *, real *, real *), xerbla_(char *, integer *), cgesvj_(char *, char *, char *, integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, complex *, integer *, real *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); + int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cpocon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), csscal_(integer *, real *, complex *, integer *), classq_(integer *, complex *, integer *, real *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgesvj_(char *, char *, char *, integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, complex *, integer *, real *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); real entrat; logical almort; complex cdummy[1]; @@ -715,6 +715,10 @@ int cgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo defr = lsame_(jobr, "N"); l2pert = lsame_(jobp, "P"); lquery = *lwork == -1 || *lrwork == -1; + iwoff = 0; + lwrk_cgeqrf__ = 0; + lwrk_cgelqf__ = 0; + lwrk_cgeqp3__ = 0; if (! (rowpiv || l2rank || l2aber || errest || lsame_(joba, "C"))) { *info = -1; @@ -1293,7 +1297,7 @@ int cgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { /* #:( */ i__1 = -(*info); - xerbla_("CGEJSV", &i__1); + xerbla_("CGEJSV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -1362,7 +1366,7 @@ int cgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { *info = -9; i__2 = -(*info); - xerbla_("CGEJSV", &i__2); + xerbla_("CGEJSV", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelq.c b/src/map/lapack2flamec/f2c/c/cgelq.c index 008b3b131..bf5ffc701 100644 --- a/src/map/lapack2flamec/f2c/c/cgelq.c +++ b/src/map/lapack2flamec/f2c/c/cgelq.c @@ -178,7 +178,7 @@ int cgelq_(integer *m, integer *n, complex *a, integer *lda, complex *t, integer logical mint, minw; integer lwmin, lwreq, lwopt, nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cgelqt_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -373,7 +373,7 @@ int cgelq_(integer *m, integer *n, complex *a, integer *lda, complex *t, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQ", &i__1); + xerbla_("CGELQ", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelq2.c b/src/map/lapack2flamec/f2c/c/cgelq2.c index 63531b644..a4856d5d9 100644 --- a/src/map/lapack2flamec/f2c/c/cgelq2.c +++ b/src/map/lapack2flamec/f2c/c/cgelq2.c @@ -127,7 +127,7 @@ int cgelq2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp integer i__, k; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -170,7 +170,7 @@ int cgelq2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQ2", &i__1); + xerbla_("CGELQ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelqf.c b/src/map/lapack2flamec/f2c/c/cgelqf.c index 21a2cd6fc..80c8dc152 100644 --- a/src/map/lapack2flamec/f2c/c/cgelqf.c +++ b/src/map/lapack2flamec/f2c/c/cgelqf.c @@ -146,7 +146,7 @@ int cgelqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cgelq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgelq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -201,7 +201,7 @@ int cgelqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQF", &i__1); + xerbla_("CGELQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelqt.c b/src/map/lapack2flamec/f2c/c/cgelqt.c index 7e3ec902d..a90c57fcd 100644 --- a/src/map/lapack2flamec/f2c/c/cgelqt.c +++ b/src/map/lapack2flamec/f2c/c/cgelqt.c @@ -131,7 +131,7 @@ int cgelqt_(integer *m, integer *n, integer *mb, complex *a, integer *lda, compl /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cgelqt3_(integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgelqt3_(integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -181,7 +181,7 @@ int cgelqt_(integer *m, integer *n, integer *mb, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQT", &i__1); + xerbla_("CGELQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelqt3.c b/src/map/lapack2flamec/f2c/c/cgelqt3.c index 27b1eb928..b5637ba09 100644 --- a/src/map/lapack2flamec/f2c/c/cgelqt3.c +++ b/src/map/lapack2flamec/f2c/c/cgelqt3.c @@ -136,7 +136,7 @@ int cgelqt3_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer iinfo; extern /* Subroutine */ - int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -181,7 +181,7 @@ int cgelqt3_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CGELQT3", &i__1); + xerbla_("CGELQT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgels.c b/src/map/lapack2flamec/f2c/c/cgels.c index 512a1f1ee..f41aa86d5 100644 --- a/src/map/lapack2flamec/f2c/c/cgels.c +++ b/src/map/lapack2flamec/f2c/c/cgels.c @@ -218,7 +218,7 @@ int cgels_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, inte int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_( char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), claset_( char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), claset_( char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; real bignum; @@ -357,7 +357,7 @@ int cgels_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CGELS ", &i__1); + xerbla_("CGELS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelsd.c b/src/map/lapack2flamec/f2c/c/cgelsd.c index 42924e118..f9ef03931 100644 --- a/src/map/lapack2flamec/f2c/c/cgelsd.c +++ b/src/map/lapack2flamec/f2c/c/cgelsd.c @@ -253,7 +253,7 @@ int cgelsd_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clalsd_( char *, integer *, integer *, integer *, real *, real *, complex *, integer *, real *, integer *, complex *, real *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -303,6 +303,7 @@ int cgelsd_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co minmn = fla_min(*m,*n); maxmn = fla_max(*m,*n); lquery = *lwork == -1; + mnthr = 0; if (*m < 0) { *info = -1; @@ -478,7 +479,7 @@ int cgelsd_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSD", &i__1); + xerbla_("CGELSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelss.c b/src/map/lapack2flamec/f2c/c/cgelss.c index 5cf4a4128..ac4336647 100644 --- a/src/map/lapack2flamec/f2c/c/cgelss.c +++ b/src/map/lapack2flamec/f2c/c/cgelss.c @@ -192,7 +192,7 @@ int cgelss_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co integer i__, bl, ie, il, mm; complex dum[1]; real eps, thr, anrm, bnrm; - integer itau, lwork_cgebrd__, lwork_cgelqf__, lwork_cgeqrf__, lwork_cungbr__, lwork_cunmbr__, lwork_cunmlq__, lwork_cunmqr__; + integer itau, lwork_cgebrd__, lwork_cgelqf__, lwork_cungbr__, lwork_cunmbr__, lwork_cunmlq__; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer iascl, ibscl; @@ -210,7 +210,7 @@ int cgelss_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_( char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -259,6 +259,7 @@ int cgelss_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co minmn = fla_min(*m,*n); maxmn = fla_max(*m,*n); lquery = *lwork == -1; + mnthr = 0; if (*m < 0) { *info = -1; @@ -298,12 +299,6 @@ int cgelss_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co { /* Path 1a - overdetermined, with many more rows than */ /* columns */ - /* Compute space needed for CGEQRF */ - cgeqrf_(m, n, &a[a_offset], lda, dum, dum, &c_n1, info); - lwork_cgeqrf__ = (integer) dum[0].r; - /* Compute space needed for CUNMQR */ - cunmqr_("L", "C", m, nrhs, n, &a[a_offset], lda, dum, &b[ b_offset], ldb, dum, &c_n1, info); - lwork_cunmqr__ = (integer) dum[0].r; mm = *n; /* Computing MAX */ i__1 = maxwrk; @@ -439,7 +434,7 @@ int cgelss_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSS", &i__1); + xerbla_("CGELSS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelst.c b/src/map/lapack2flamec/f2c/c/cgelst.c index bfea148ca..1c9571a27 100644 --- a/src/map/lapack2flamec/f2c/c/cgelst.c +++ b/src/map/lapack2flamec/f2c/c/cgelst.c @@ -222,7 +222,7 @@ int cgelst_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, int int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cgelqt_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -329,7 +329,7 @@ int cgelst_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CGELST ", &i__1); + xerbla_("CGELST ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelsx.c b/src/map/lapack2flamec/f2c/c/cgelsx.c index 52ef4d946..5554881c0 100644 --- a/src/map/lapack2flamec/f2c/c/cgelsx.c +++ b/src/map/lapack2flamec/f2c/c/cgelsx.c @@ -216,7 +216,7 @@ int cgelsx_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), cgeqpf_(integer *, integer *, complex *, integer *, integer *, complex *, complex *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int clatzm_(char *, integer *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *); @@ -288,7 +288,7 @@ int cgelsx_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSX", &i__1); + xerbla_("CGELSX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgelsy.c b/src/map/lapack2flamec/f2c/c/cgelsy.c index b0e91d9a3..ab5428da2 100644 --- a/src/map/lapack2flamec/f2c/c/cgelsy.c +++ b/src/map/lapack2flamec/f2c/c/cgelsy.c @@ -249,7 +249,7 @@ int cgelsy_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -354,7 +354,7 @@ int cgelsy_(integer *m, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGELSY", &i__1); + xerbla_("CGELSY", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgemlq.c b/src/map/lapack2flamec/f2c/c/cgemlq.c index 17674e930..feb4c1c07 100644 --- a/src/map/lapack2flamec/f2c/c/cgemlq.c +++ b/src/map/lapack2flamec/f2c/c/cgemlq.c @@ -1,3 +1,6 @@ +/* + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. +*/ /* ../netlib/v3.9.0/cgemlq.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* > \brief \b CGEMLQ */ @@ -183,9 +186,8 @@ int cgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, complex logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int cgemlqt_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -236,21 +238,6 @@ int cgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, complex lw = *m * mb; mn = *n; } - if (nb > *k && mn > *k) - { - if ((mn - *k) % (nb - *k) == 0) - { - nblcks = (mn - *k) / (nb - *k); - } - else - { - nblcks = (mn - *k) / (nb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -297,7 +284,7 @@ int cgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CGEMLQ", &i__1); + xerbla_("CGEMLQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgemlqt.c b/src/map/lapack2flamec/f2c/c/cgemlqt.c index ceb5b3d49..7e8d22f62 100644 --- a/src/map/lapack2flamec/f2c/c/cgemlqt.c +++ b/src/map/lapack2flamec/f2c/c/cgemlqt.c @@ -163,7 +163,7 @@ int cgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine -- */ @@ -251,7 +251,7 @@ int cgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CGEMLQT", &i__1); + xerbla_("CGEMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgemqr.c b/src/map/lapack2flamec/f2c/c/cgemqr.c index f982dc931..1eeb1faf4 100644 --- a/src/map/lapack2flamec/f2c/c/cgemqr.c +++ b/src/map/lapack2flamec/f2c/c/cgemqr.c @@ -1,3 +1,6 @@ +/* + Copyright (c) 2021-2023 Advanced Micro Devices, Inc. All rights reserved. +*/ /* ../netlib/v3.9.0/cgemqr.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* > \brief \b CGEMQR */ @@ -185,9 +188,8 @@ int cgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, complex logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int cgemqrt_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -238,21 +240,6 @@ int cgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, complex lw = mb * nb; mn = *n; } - if (mb > *k && mn > *k) - { - if ((mn - *k) % (mb - *k) == 0) - { - nblcks = (mn - *k) / (mb - *k); - } - else - { - nblcks = (mn - *k) / (mb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -298,7 +285,7 @@ int cgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CGEMQR", &i__1); + xerbla_("CGEMQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgemqrt.c b/src/map/lapack2flamec/f2c/c/cgemqrt.c index 7fc1d93c9..8d2fc624d 100644 --- a/src/map/lapack2flamec/f2c/c/cgemqrt.c +++ b/src/map/lapack2flamec/f2c/c/cgemqrt.c @@ -177,7 +177,7 @@ int cgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -266,7 +266,7 @@ int cgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CGEMQRT", &i__1); + xerbla_("CGEMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeql2.c b/src/map/lapack2flamec/f2c/c/cgeql2.c index 5cea51150..ab2826db8 100644 --- a/src/map/lapack2flamec/f2c/c/cgeql2.c +++ b/src/map/lapack2flamec/f2c/c/cgeql2.c @@ -135,7 +135,7 @@ int cgeql2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp integer i__, k; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -178,7 +178,7 @@ int cgeql2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQL2", &i__1); + xerbla_("CGEQL2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqlf.c b/src/map/lapack2flamec/f2c/c/cgeqlf.c index 9f39c61d6..33c3aa0e2 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqlf.c +++ b/src/map/lapack2flamec/f2c/c/cgeqlf.c @@ -1,4 +1,4 @@ -/* ../netlib/cgeqlf.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; +/*../netlib/cgeqlf.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; @@ -150,7 +150,7 @@ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cgeql2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgeql2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -194,6 +194,7 @@ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp { *info = -4; } + nb = ilaenv_(&c__1, "CGEQLF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { k = fla_min(*m,*n); @@ -203,7 +204,6 @@ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp } else { - nb = ilaenv_(&c__1, "CGEQLF", " ", m, n, &c_n1, &c_n1); lwkopt = *n * nb; } work[1].r = (real) lwkopt; @@ -216,7 +216,7 @@ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQLF", &i__1); + xerbla_("CGEQLF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqp3.c b/src/map/lapack2flamec/f2c/c/cgeqp3.c index f9398329e..02e65cfc5 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqp3.c +++ b/src/map/lapack2flamec/f2c/c/cgeqp3.c @@ -172,7 +172,7 @@ int cgeqp3_(integer *m, integer *n, complex *a, integer *lda, integer *jpvt, com int claqp2_(integer *, integer *, integer *, complex *, integer *, integer *, complex *, real *, real *, complex *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_( char *, integer *); + int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int claqps_(integer *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, real *, real *, complex *, complex *, integer *); @@ -252,7 +252,7 @@ int cgeqp3_(integer *m, integer *n, complex *a, integer *lda, integer *jpvt, com if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQP3", &i__1); + xerbla_("CGEQP3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqpf.c b/src/map/lapack2flamec/f2c/c/cgeqpf.c index 398fb78fb..f8a81f792 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqpf.c +++ b/src/map/lapack2flamec/f2c/c/cgeqpf.c @@ -170,7 +170,7 @@ int cgeqpf_(integer *m, integer *n, complex *a, integer *lda, integer *jpvt, com int cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -218,7 +218,7 @@ int cgeqpf_(integer *m, integer *n, complex *a, integer *lda, integer *jpvt, com if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQPF", &i__1); + xerbla_("CGEQPF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqr.c b/src/map/lapack2flamec/f2c/c/cgeqr.c index daca9bc82..8880e78de 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqr.c +++ b/src/map/lapack2flamec/f2c/c/cgeqr.c @@ -188,7 +188,7 @@ int cgeqr_(integer *m, integer *n, complex *a, integer *lda, complex *t, integer logical mint, minw; integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cgeqrt_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -365,7 +365,7 @@ int cgeqr_(integer *m, integer *n, complex *a, integer *lda, complex *t, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQR", &i__1); + xerbla_("CGEQR", &i__1, (ftnlen)5); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqr2.c b/src/map/lapack2flamec/f2c/c/cgeqr2.c index 60fc0369e..ce2d26151 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqr2.c +++ b/src/map/lapack2flamec/f2c/c/cgeqr2.c @@ -132,7 +132,7 @@ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp integer i__, k; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -175,7 +175,7 @@ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQR2", &i__1); + xerbla_("CGEQR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqr2p.c b/src/map/lapack2flamec/f2c/c/cgeqr2p.c index cfb4412de..269c609c6 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqr2p.c +++ b/src/map/lapack2flamec/f2c/c/cgeqr2p.c @@ -132,7 +132,7 @@ int cgeqr2p_(integer *m, integer *n, complex *a, integer * lda, complex *tau, co integer i__, k; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *), clarfgp_(integer *, complex *, complex *, integer *, complex *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clarfgp_(integer *, complex *, complex *, integer *, complex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -175,7 +175,7 @@ int cgeqr2p_(integer *m, integer *n, complex *a, integer * lda, complex *tau, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQR2P", &i__1); + xerbla_("CGEQR2P", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqrf.c b/src/map/lapack2flamec/f2c/c/cgeqrf.c index 00815242a..67f4cac9e 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqrf.c +++ b/src/map/lapack2flamec/f2c/c/cgeqrf.c @@ -158,7 +158,7 @@ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -213,7 +213,7 @@ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRF", &i__1); + xerbla_("CGEQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqrfp.c b/src/map/lapack2flamec/f2c/c/cgeqrfp.c index 296e5706e..a4d3a136b 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqrfp.c +++ b/src/map/lapack2flamec/f2c/c/cgeqrfp.c @@ -147,7 +147,7 @@ int cgeqrfp_(integer *m, integer *n, complex *a, integer * lda, complex *tau, co /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -204,7 +204,7 @@ int cgeqrfp_(integer *m, integer *n, complex *a, integer * lda, complex *tau, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRFP", &i__1); + xerbla_("CGEQRFP", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqrt.c b/src/map/lapack2flamec/f2c/c/cgeqrt.c index 8a6ca303f..0c40ac4e1 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqrt.c +++ b/src/map/lapack2flamec/f2c/c/cgeqrt.c @@ -145,7 +145,7 @@ int cgeqrt_(integer *m, integer *n, integer *nb, complex *a, integer *lda, compl /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cgeqrt2_(integer *, integer *, complex *, integer *, complex *, integer *, integer *), cgeqrt3_(integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgeqrt2_(integer *, integer *, complex *, integer *, complex *, integer *, integer *), cgeqrt3_(integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -195,7 +195,7 @@ int cgeqrt_(integer *m, integer *n, integer *nb, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRT", &i__1); + xerbla_("CGEQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqrt2.c b/src/map/lapack2flamec/f2c/c/cgeqrt2.c index 74ccb4335..507d76b8a 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqrt2.c +++ b/src/map/lapack2flamec/f2c/c/cgeqrt2.c @@ -150,7 +150,7 @@ int cgeqrt2_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte int cgerc_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); complex alpha; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -195,7 +195,7 @@ int cgeqrt2_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRT2", &i__1); + xerbla_("CGEQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgeqrt3.c b/src/map/lapack2flamec/f2c/c/cgeqrt3.c index 6afc9fb05..12c213050 100644 --- a/src/map/lapack2flamec/f2c/c/cgeqrt3.c +++ b/src/map/lapack2flamec/f2c/c/cgeqrt3.c @@ -150,7 +150,7 @@ int cgeqrt3_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer iinfo; extern /* Subroutine */ - int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -195,7 +195,7 @@ int cgeqrt3_(integer *m, integer *n, complex *a, integer * lda, complex *t, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CGEQRT3", &i__1); + xerbla_("CGEQRT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgerfs.c b/src/map/lapack2flamec/f2c/c/cgerfs.c index 965f1a79d..a5c6407e8 100644 --- a/src/map/lapack2flamec/f2c/c/cgerfs.c +++ b/src/map/lapack2flamec/f2c/c/cgerfs.c @@ -215,7 +215,7 @@ int cgerfs_(char *trans, integer *n, integer *nrhs, complex * a, integer *lda, c extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), cgetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); logical notran; char transn[1], transt[1]; real lstres; @@ -298,7 +298,7 @@ int cgerfs_(char *trans, integer *n, integer *nrhs, complex * a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGERFS", &i__1); + xerbla_("CGERFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgerfsx.c b/src/map/lapack2flamec/f2c/c/cgerfsx.c index db6e9eb95..e340f40df 100644 --- a/src/map/lapack2flamec/f2c/c/cgerfsx.c +++ b/src/map/lapack2flamec/f2c/c/cgerfsx.c @@ -446,7 +446,7 @@ int cgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, complex *a, i int cgecon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -599,7 +599,7 @@ int cgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, complex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("CGERFSX", &i__1); + xerbla_("CGERFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgerq2.c b/src/map/lapack2flamec/f2c/c/cgerq2.c index 383bad7d4..f2554e09d 100644 --- a/src/map/lapack2flamec/f2c/c/cgerq2.c +++ b/src/map/lapack2flamec/f2c/c/cgerq2.c @@ -130,7 +130,7 @@ int cgerq2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp integer i__, k; complex alpha; extern /* Subroutine */ - int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -173,7 +173,7 @@ int cgerq2_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGERQ2", &i__1); + xerbla_("CGERQ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgerqf.c b/src/map/lapack2flamec/f2c/c/cgerqf.c index 338f15334..d4cca9bec 100644 --- a/src/map/lapack2flamec/f2c/c/cgerqf.c +++ b/src/map/lapack2flamec/f2c/c/cgerqf.c @@ -150,7 +150,7 @@ int cgerqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -180,6 +180,7 @@ int cgerqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -218,7 +219,7 @@ int cgerqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGERQF", &i__1); + xerbla_("CGERQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesdd.c b/src/map/lapack2flamec/f2c/c/cgesdd.c index fb0d12482..8ac3e73ef 100644 --- a/src/map/lapack2flamec/f2c/c/cgesdd.c +++ b/src/map/lapack2flamec/f2c/c/cgesdd.c @@ -285,7 +285,7 @@ int cgesdd_(char *jobz, integer *m, integer *n, complex *a, integer *lda, real * int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clacrm_( integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, real *), clarcm_(integer *, integer *, real *, integer *, complex *, integer *, complex *, integer *, real *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), sbdsdc_(char *, char *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), cungbr_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cungbr_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cunmbr_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), cunglq_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -814,7 +814,7 @@ int cgesdd_(char *jobz, integer *m, integer *n, complex *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("CGESDD", &i__1); + xerbla_("CGESDD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesv.c b/src/map/lapack2flamec/f2c/c/cgesv.c index bd924bb93..99e352850 100644 --- a/src/map/lapack2flamec/f2c/c/cgesv.c +++ b/src/map/lapack2flamec/f2c/c/cgesv.c @@ -126,7 +126,7 @@ int cgesv_(integer *n, integer *nrhs, complex *a, integer * lda, integer *ipiv, integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -171,7 +171,7 @@ int cgesv_(integer *n, integer *nrhs, complex *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CGESV ", &i__1); + xerbla_("CGESV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvd.c b/src/map/lapack2flamec/f2c/c/cgesvd.c index 66d5732b1..17ba06a3e 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvd.c +++ b/src/map/lapack2flamec/f2c/c/cgesvd.c @@ -13,7 +13,6 @@ static complex c_b2 = ; static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c_n1 = -1; static integer c__1 = 1; /* > \brief CGESVD computes the singular value decomposition (SVD) for GE matrices */ @@ -244,8 +243,7 @@ int cgesvd_(char *jobu, char *jobvt, integer *m, integer *n, complex *a, integer AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -271,7 +269,7 @@ int cgesvd_(char *jobu, char *jobvt, integer *m, integer *n, complex *a, integer int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_( char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), xerbla_(char *, integer *), cungbr_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cungbr_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -333,6 +331,8 @@ int cgesvd_(char *jobu, char *jobvt, integer *m, integer *n, complex *a, integer wntvo = lsame_(jobvt, "O"); wntvn = lsame_(jobvt, "N"); lquery = *lwork == -1; + mnthr = 0; + wrkbl = 0; if (! (wntua || wntus || wntuo || wntun)) { *info = -1; @@ -896,7 +896,7 @@ int cgesvd_(char *jobu, char *jobvt, integer *m, integer *n, complex *a, integer if (*info != 0) { i__2 = -(*info); - xerbla_("CGESVD", &i__2); + xerbla_("CGESVD", &i__2, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvdq.c b/src/map/lapack2flamec/f2c/c/cgesvdq.c index 3b00a9657..83d742c92 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvdq.c +++ b/src/map/lapack2flamec/f2c/c/cgesvdq.c @@ -481,7 +481,7 @@ int cgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), csscal_( integer *, real *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int cgesvd_(char *, char *, integer *, integer *, complex *, integer *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cpocon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer * ); + int cgesvd_(char *, char *, integer *, integer *, complex *, integer *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cpocon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer * ); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -547,6 +547,10 @@ int cgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer acclh = lsame_(joba, "H") || conda; rowprm = lsame_(jobp, "P"); rtrans = lsame_(jobr, "T"); + sconda = 0.f; + lwunq = 0; + lwrk_cunmqr__ = 0; + lwrk_cgeqp3__ = 0; if (rowprm) { /* Computing MAX */ @@ -942,7 +946,7 @@ int cgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGESVDQ", &i__1); + xerbla_("CGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -985,7 +989,7 @@ int cgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__2 = -(*info); - xerbla_("CGESVDQ", &i__2); + xerbla_("CGESVDQ", &i__2, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -1078,7 +1082,7 @@ int cgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__1 = -(*info); - xerbla_("CGESVDQ", &i__1); + xerbla_("CGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvdx.c b/src/map/lapack2flamec/f2c/c/cgesvdx.c index 83303affb..84cc3a750 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvdx.c +++ b/src/map/lapack2flamec/f2c/c/cgesvdx.c @@ -8,7 +8,6 @@ static complex c_b1 = ; static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c__1 = 1; static integer c_n1 = -1; /* > \brief CGESVDX computes the singular value decomposition (SVD) for GE matrices */ @@ -289,8 +288,7 @@ int cgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, comp AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4, i__5; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4, i__5; real r__1; complex q__1; char ch__1[2]; @@ -318,12 +316,11 @@ int cgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, comp int cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clascl_( char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); - real abstol; extern /* Subroutine */ int cunmbr_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); char rngtgk[1]; @@ -377,11 +374,11 @@ int cgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, comp /* Function Body */ *ns = 0; *info = 0; - abstol = slamch_("S") * 2; lquery = *lwork == -1; minmn = fla_min(*m,*n); wantu = lsame_(jobu, "V"); wantvt = lsame_(jobvt, "V"); + mnthr = 0; if (wantu || wantvt) { *(unsigned char *)jobz = 'V'; @@ -559,7 +556,7 @@ int cgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, comp if (*info != 0) { i__2 = -(*info); - xerbla_("CGESVDX", &i__2); + xerbla_("CGESVDX", &i__2, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvj.c b/src/map/lapack2flamec/f2c/c/cgesvj.c index 7f2faf121..a611a604c 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvj.c +++ b/src/map/lapack2flamec/f2c/c/cgesvj.c @@ -421,7 +421,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ @@ -535,7 +535,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CGESVJ", &i__1); + xerbla_("CGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -595,7 +595,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex { *info = -4; i__1 = -(*info); - xerbla_("CGESVJ", &i__1); + xerbla_("CGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -637,7 +637,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex { *info = -6; i__2 = -(*info); - xerbla_("CGESVJ", &i__2); + xerbla_("CGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -681,7 +681,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex { *info = -6; i__2 = -(*info); - xerbla_("CGESVJ", &i__2); + xerbla_("CGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -725,7 +725,7 @@ int cgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, complex { *info = -6; i__2 = -(*info); - xerbla_("CGESVJ", &i__2); + xerbla_("CGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvx.c b/src/map/lapack2flamec/f2c/c/cgesvx.c index e97aecc0a..26fbe3b27 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvx.c +++ b/src/map/lapack2flamec/f2c/c/cgesvx.c @@ -373,7 +373,7 @@ int cgesvx_(char *fact, char *trans, integer *n, integer * nrhs, complex *a, int int cgeequ_(integer *, integer *, complex *, integer *, real *, real *, real *, real *, real *, integer *); logical nofact; extern /* Subroutine */ - int cgerfs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int cgerfs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real clantr_(char *, char *, char *, integer *, integer *, complex *, integer *, real *); integer infequ; @@ -430,6 +430,8 @@ int cgesvx_(char *fact, char *trans, integer *n, integer * nrhs, complex *a, int nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -553,7 +555,7 @@ int cgesvx_(char *fact, char *trans, integer *n, integer * nrhs, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CGESVX", &i__1); + xerbla_("CGESVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgesvxx.c b/src/map/lapack2flamec/f2c/c/cgesvxx.c index b6c0320a4..d5f8d6546 100644 --- a/src/map/lapack2flamec/f2c/c/cgesvxx.c +++ b/src/map/lapack2flamec/f2c/c/cgesvxx.c @@ -567,7 +567,7 @@ int cgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, complex *a, in extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; logical colequ; @@ -757,7 +757,7 @@ int cgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CGESVXX", &i__1); + xerbla_("CGESVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgetc2.c b/src/map/lapack2flamec/f2c/c/cgetc2.c index de1bd850b..d119af15c 100644 --- a/src/map/lapack2flamec/f2c/c/cgetc2.c +++ b/src/map/lapack2flamec/f2c/c/cgetc2.c @@ -162,6 +162,9 @@ int cgetc2_(integer *n, complex *a, integer *lda, integer * ipiv, integer *jpiv, --jpiv; /* Function Body */ *info = 0; + smin = 0; + jpv = 0; + ipv = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/cgetrf2.c b/src/map/lapack2flamec/f2c/c/cgetrf2.c index 2c181288e..d36cc436f 100644 --- a/src/map/lapack2flamec/f2c/c/cgetrf2.c +++ b/src/map/lapack2flamec/f2c/c/cgetrf2.c @@ -139,7 +139,7 @@ int cgetrf2_(integer *m, integer *n, complex *a, integer * lda, integer *ipiv, i extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), claswp_( integer *, complex *, integer *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), claswp_( integer *, complex *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -164,6 +164,7 @@ int cgetrf2_(integer *m, integer *n, complex *a, integer * lda, integer *ipiv, i /* Parameter adjustments */ #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; + static TLS_CLASS_SPEC integer progress_size = 0; #endif a_dim1 = *lda; a_offset = 1 + a_dim1; @@ -186,7 +187,7 @@ int cgetrf2_(integer *m, integer *n, complex *a, integer * lda, integer *ipiv, i if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRF2", &i__1); + xerbla_("CGETRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -275,24 +276,24 @@ int cgetrf2_(integer *m, integer *n, complex *a, integer * lda, integer *ipiv, i #endif if(aocl_fla_progress_ptr) { - if(step_count == 0 || step_count==size ){ - size=fla_min(*m,*n); - step_count =1; + if(progress_step_count == 0 || progress_step_count == progress_size ){ + progress_size = fla_min(*m,*n); + progress_step_count = 1; } - if(!(step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) + if(!(progress_step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) { - ++step_count; - if((step_count%8)==0 || step_count==size) + ++progress_step_count; + if((progress_step_count%8)==0 || progress_step_count == progress_size) { - AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF2",7,&step_count,&thread_id,&total_threads); + AOCL_FLA_PROGRESS_FUNC_PTR("CGETRF2",7,&progress_step_count,&progress_thread_id,&progress_total_threads); } } } - #endif + #endif cgetrf2_(m, &n1, &a[a_offset], lda, &ipiv[1], &iinfo); if (*info == 0 && iinfo > 0) @@ -336,4 +337,3 @@ int cgetrf2_(integer *m, integer *n, complex *a, integer * lda, integer *ipiv, i /* End of CGETRF2 */ } /* cgetrf2_ */ - diff --git a/src/map/lapack2flamec/f2c/c/cgetri.c b/src/map/lapack2flamec/f2c/c/cgetri.c index 90891bbb4..de0343343 100644 --- a/src/map/lapack2flamec/f2c/c/cgetri.c +++ b/src/map/lapack2flamec/f2c/c/cgetri.c @@ -136,7 +136,7 @@ int cgetri_(integer *n, complex *a, integer *lda, integer * ipiv, complex *work, int cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ldwork; extern /* Subroutine */ int ctrtri_(char *, char *, integer *, complex *, integer *, integer *); @@ -191,7 +191,7 @@ int cgetri_(integer *n, complex *a, integer *lda, integer * ipiv, complex *work, if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRI", &i__1); + xerbla_("CGETRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgetrs.c b/src/map/lapack2flamec/f2c/c/cgetrs.c index f8559ead5..9957a00e9 100644 --- a/src/map/lapack2flamec/f2c/c/cgetrs.c +++ b/src/map/lapack2flamec/f2c/c/cgetrs.c @@ -133,7 +133,7 @@ int cgetrs_(char *trans, integer *n, integer *nrhs, complex * a, integer *lda, i /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -190,7 +190,7 @@ int cgetrs_(char *trans, integer *n, integer *nrhs, complex * a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("CGETRS", &i__1); + xerbla_("CGETRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgetsls.c b/src/map/lapack2flamec/f2c/c/cgetsls.c index 8c0332471..d1f642d9b 100644 --- a/src/map/lapack2flamec/f2c/c/cgetsls.c +++ b/src/map/lapack2flamec/f2c/c/cgetsls.c @@ -202,7 +202,7 @@ int cgetsls_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, in int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int cgemlq_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), cgemqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); + int cgemlq_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgemqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); integer scllen; real bignum, smlnum; integer wsizem, wsizeo; @@ -327,7 +327,7 @@ int cgetsls_(char *trans, integer *m, integer *n, integer * nrhs, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CGETSLS", &i__1); + xerbla_("CGETSLS", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgetsqrhrt.c b/src/map/lapack2flamec/f2c/c/cgetsqrhrt.c index d1822189d..0d816a722 100644 --- a/src/map/lapack2flamec/f2c/c/cgetsqrhrt.c +++ b/src/map/lapack2flamec/f2c/c/cgetsqrhrt.c @@ -181,7 +181,7 @@ int cgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 int cungtsqr_row_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); integer iinfo; extern /* Subroutine */ - int ccopy_(integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ccopy_(integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int clatsqr_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -300,7 +300,7 @@ int cgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 if (*info != 0) { i__1 = -(*info); - xerbla_("CGETSQRHRT", &i__1); + xerbla_("CGETSQRHRT", &i__1, (ftnlen)10); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/cggbak.c b/src/map/lapack2flamec/f2c/c/cggbak.c index 82bd745e5..e77f832f9 100644 --- a/src/map/lapack2flamec/f2c/c/cggbak.c +++ b/src/map/lapack2flamec/f2c/c/cggbak.c @@ -150,7 +150,7 @@ int cggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real int cswap_(integer *, complex *, integer *, complex *, integer *); logical leftv; extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -219,7 +219,7 @@ int cggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real if (*info != 0) { i__1 = -(*info); - xerbla_("CGGBAK", &i__1); + xerbla_("CGGBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggbal.c b/src/map/lapack2flamec/f2c/c/cggbal.c index 632502f43..ba7f03f9b 100644 --- a/src/map/lapack2flamec/f2c/c/cggbal.c +++ b/src/map/lapack2flamec/f2c/c/cggbal.c @@ -207,7 +207,7 @@ int cggbal_(char *job, integer *n, complex *a, integer *lda, complex *b, integer extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lsfmin, lsfmax; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -264,7 +264,7 @@ int cggbal_(char *job, integer *n, complex *a, integer *lda, complex *b, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGGBAL", &i__1); + xerbla_("CGGBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgges.c b/src/map/lapack2flamec/f2c/c/cgges.c index 8a96d3451..2ed465829 100644 --- a/src/map/lapack2flamec/f2c/c/cgges.c +++ b/src/map/lapack2flamec/f2c/c/cgges.c @@ -272,7 +272,7 @@ the routine */ /* > \ingroup complexGEeigen */ /* ===================================================================== */ /* Subroutine */ -int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, complex *a, integer *lda, complex *b, integer * ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer * lwork, real *rwork, logical *bwork, integer *info) +int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp2 selctg, integer *n, complex *a, integer *lda, complex *b, integer * ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer * lwork, real *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_5); #if LF_AOCL_DTL_LOG_ENABLE @@ -309,7 +309,7 @@ int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, comp int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -471,7 +471,7 @@ int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGGES ", &i__1); + xerbla_("CGGES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgges3.c b/src/map/lapack2flamec/f2c/c/cgges3.c index b16535de2..d22df667b 100644 --- a/src/map/lapack2flamec/f2c/c/cgges3.c +++ b/src/map/lapack2flamec/f2c/c/cgges3.c @@ -271,7 +271,7 @@ the routine */ /* > \ingroup complexGEeigen */ /* ===================================================================== */ /* Subroutine */ -int cgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, complex *a, integer *lda, complex *b, integer * ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer * lwork, real *rwork, logical *bwork, integer *info) +int cgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp2 selctg, integer *n, complex *a, integer *lda, complex *b, integer * ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer * lwork, real *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_5); #if LF_AOCL_DTL_LOG_ENABLE @@ -312,7 +312,7 @@ int cgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, com int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int chgeqz_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), ctgsen_(integer *, logical *, logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, integer *, real *, real *, real *, complex *, integer *, integer *, integer *, integer *); @@ -491,7 +491,7 @@ int cgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, com if (*info != 0) { i__1 = -(*info); - xerbla_("CGGES3 ", &i__1); + xerbla_("CGGES3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggesx.c b/src/map/lapack2flamec/f2c/c/cggesx.c index df395b3c8..b99c0dca0 100644 --- a/src/map/lapack2flamec/f2c/c/cggesx.c +++ b/src/map/lapack2flamec/f2c/c/cggesx.c @@ -337,7 +337,7 @@ the */ /* > \ingroup complexGEeigen */ /* ===================================================================== */ /* Subroutine */ -int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, integer *n, complex *a, integer *lda, complex *b, integer *ldb, integer *sdim, complex *alpha, complex *beta, complex * vsl, integer *ldvsl, complex *vsr, integer *ldvsr, real *rconde, real *rcondv, complex *work, integer *lwork, real *rwork, integer *iwork, integer *liwork, logical *bwork, integer *info) +int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp2 selctg, char *sense, integer *n, complex *a, integer *lda, complex *b, integer *ldb, integer *sdim, complex *alpha, complex *beta, complex * vsl, integer *ldvsl, complex *vsr, integer *ldvsr, real *rconde, real *rcondv, complex *work, integer *lwork, real *rwork, integer *iwork, integer *liwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_5); #if LF_AOCL_DTL_LOG_ENABLE @@ -372,7 +372,7 @@ int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in int cgghrd_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern real slamch_(char *); real bignum; @@ -589,7 +589,7 @@ int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in if (*info != 0) { i__1 = -(*info); - xerbla_("CGGESX", &i__1); + xerbla_("CGGESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggev.c b/src/map/lapack2flamec/f2c/c/cggev.c index feb683c7b..09155d7fe 100644 --- a/src/map/lapack2flamec/f2c/c/cggev.c +++ b/src/map/lapack2flamec/f2c/c/cggev.c @@ -258,7 +258,7 @@ int cggev_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), ctgevc_(char *, char *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, complex *, real *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), ctgevc_(char *, char *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, complex *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical ldumma[1]; char chtemp[1]; real bignum; @@ -421,7 +421,7 @@ int cggev_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CGGEV ", &i__1); + xerbla_("CGGEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggev3.c b/src/map/lapack2flamec/f2c/c/cggev3.c index 6d32060a2..f6699ec98 100644 --- a/src/map/lapack2flamec/f2c/c/cggev3.c +++ b/src/map/lapack2flamec/f2c/c/cggev3.c @@ -260,7 +260,7 @@ int cggev3_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, comp int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), ctgevc_(char *, char *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, complex *, real *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), ctgevc_(char *, char *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, complex *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical ldumma[1]; char chtemp[1]; real bignum; @@ -447,7 +447,7 @@ int cggev3_(char *jobvl, char *jobvr, integer *n, complex *a, integer *lda, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CGGEV3 ", &i__1); + xerbla_("CGGEV3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggevx.c b/src/map/lapack2flamec/f2c/c/cggevx.c index e0819f500..58623bc2c 100644 --- a/src/map/lapack2flamec/f2c/c/cggevx.c +++ b/src/map/lapack2flamec/f2c/c/cggevx.c @@ -426,7 +426,7 @@ int cggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, co int chgeqz_(char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *), ctgsna_(char *, char *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *, integer *); integer ijobvl; extern /* Subroutine */ - int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern real slamch_(char *); integer ijobvr; @@ -620,7 +620,7 @@ int cggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGGEVX", &i__1); + xerbla_("CGGEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggglm.c b/src/map/lapack2flamec/f2c/c/cggglm.c index 8201b7c0f..ce02b58d1 100644 --- a/src/map/lapack2flamec/f2c/c/cggglm.c +++ b/src/map/lapack2flamec/f2c/c/cggglm.c @@ -191,7 +191,7 @@ int cggglm_(integer *n, integer *m, integer *p, complex *a, integer *lda, comple /* Local variables */ integer i__, nb, np, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), cggqrf_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), cggqrf_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -286,7 +286,7 @@ int cggglm_(integer *n, integer *m, integer *p, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CGGGLM", &i__1); + xerbla_("CGGGLM", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgghd3.c b/src/map/lapack2flamec/f2c/c/cgghd3.c index f70d77309..5e55b93d9 100644 --- a/src/map/lapack2flamec/f2c/c/cgghd3.c +++ b/src/map/lapack2flamec/f2c/c/cgghd3.c @@ -283,7 +283,7 @@ int cgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, c int cgghrd_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK computational routine -- */ @@ -378,7 +378,7 @@ int cgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGGHD3", &i__1); + xerbla_("CGGHD3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgghrd.c b/src/map/lapack2flamec/f2c/c/cgghrd.c index c2dd02b12..4d2b84c86 100644 --- a/src/map/lapack2flamec/f2c/c/cgghrd.c +++ b/src/map/lapack2flamec/f2c/c/cgghrd.c @@ -237,7 +237,7 @@ int cgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, c extern logical lsame_(char *, char *); complex ctemp; extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icompq, icompz; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -354,7 +354,7 @@ int cgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGGHRD", &i__1); + xerbla_("CGGHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgglse.c b/src/map/lapack2flamec/f2c/c/cgglse.c index 1ccf23899..74a683fff 100644 --- a/src/map/lapack2flamec/f2c/c/cgglse.c +++ b/src/map/lapack2flamec/f2c/c/cgglse.c @@ -183,7 +183,7 @@ int cgglse_(integer *m, integer *n, integer *p, complex *a, integer *lda, comple /* Local variables */ integer nb, mn, nr, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), cggrqf_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), cggrqf_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -278,7 +278,7 @@ int cgglse_(integer *m, integer *n, integer *p, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CGGLSE", &i__1); + xerbla_("CGGLSE", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggqrf.c b/src/map/lapack2flamec/f2c/c/cggqrf.c index 7163bed6a..e0447d7aa 100644 --- a/src/map/lapack2flamec/f2c/c/cggqrf.c +++ b/src/map/lapack2flamec/f2c/c/cggqrf.c @@ -217,7 +217,7 @@ int cggqrf_(integer *n, integer *m, integer *p, complex *a, integer *lda, comple /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgerqf_( integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(char *, integer *); + int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgerqf_( integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -298,7 +298,7 @@ int cggqrf_(integer *n, integer *m, integer *p, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CGGQRF", &i__1); + xerbla_("CGGQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggrqf.c b/src/map/lapack2flamec/f2c/c/cggrqf.c index 6e7308e8d..1e61fdc0d 100644 --- a/src/map/lapack2flamec/f2c/c/cggrqf.c +++ b/src/map/lapack2flamec/f2c/c/cggrqf.c @@ -216,7 +216,7 @@ int cggrqf_(integer *m, integer *p, integer *n, complex *a, integer *lda, comple /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgerqf_( integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(char *, integer *); + int cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgerqf_( integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmrq_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -297,7 +297,7 @@ int cggrqf_(integer *m, integer *p, integer *n, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CGGRQF", &i__1); + xerbla_("CGGRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggsvd.c b/src/map/lapack2flamec/f2c/c/cggsvd.c index dbc88470e..bdbf16a2e 100644 --- a/src/map/lapack2flamec/f2c/c/cggsvd.c +++ b/src/map/lapack2flamec/f2c/c/cggsvd.c @@ -360,7 +360,7 @@ int cggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer int ctgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *), cggsvp_( char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, real *, complex *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cggsvp_( char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, real *, complex *, complex *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -453,7 +453,7 @@ int cggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVD", &i__1); + xerbla_("CGGSVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggsvd3.c b/src/map/lapack2flamec/f2c/c/cggsvd3.c index 6cc946b41..8f87ab049 100644 --- a/src/map/lapack2flamec/f2c/c/cggsvd3.c +++ b/src/map/lapack2flamec/f2c/c/cggsvd3.c @@ -380,7 +380,7 @@ int cggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer int ctgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -498,7 +498,7 @@ int cggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVD3", &i__1); + xerbla_("CGGSVD3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggsvp.c b/src/map/lapack2flamec/f2c/c/cggsvp.c index 7359d7abc..9c02564ad 100644 --- a/src/map/lapack2flamec/f2c/c/cggsvp.c +++ b/src/map/lapack2flamec/f2c/c/cggsvp.c @@ -286,7 +286,7 @@ int cggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cgeqpf_(integer *, integer *, complex *, integer *, integer *, complex *, complex *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); + int cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cgeqpf_(integer *, integer *, complex *, integer *, integer *, complex *, complex *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); logical forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -386,7 +386,7 @@ int cggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVP", &i__1); + xerbla_("CGGSVP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cggsvp3.c b/src/map/lapack2flamec/f2c/c/cggsvp3.c index d19e2eeec..0661dca93 100644 --- a/src/map/lapack2flamec/f2c/c/cggsvp3.c +++ b/src/map/lapack2flamec/f2c/c/cggsvp3.c @@ -306,7 +306,7 @@ int cggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int cgeqp3_(integer *, integer *, complex *, integer *, integer *, complex *, complex *, integer *, real *, integer *), cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_( char *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); + int cgeqp3_(integer *, integer *, complex *, integer *, integer *, complex *, complex *, integer *, real *, integer *), cgeqr2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cgerq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); logical forwrd; integer lwkopt; logical lquery; @@ -440,7 +440,7 @@ int cggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGGSVP3", &i__1); + xerbla_("CGGSVP3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgsvj0.c b/src/map/lapack2flamec/f2c/c/cgsvj0.c index b80324e19..422ec3614 100644 --- a/src/map/lapack2flamec/f2c/c/cgsvj0.c +++ b/src/map/lapack2flamec/f2c/c/cgsvj0.c @@ -254,7 +254,7 @@ int cgsvj0_(char *jobv, integer *m, integer *n, complex *a, integer *lda, comple logical rotok; extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); + int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern integer isamax_(integer *, real *, integer *); integer blskip; @@ -348,7 +348,7 @@ int cgsvj0_(char *jobv, integer *m, integer *n, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CGSVJ0", &i__1); + xerbla_("CGSVJ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgsvj1.c b/src/map/lapack2flamec/f2c/c/cgsvj1.c index 249fccb22..ea4587ec6 100644 --- a/src/map/lapack2flamec/f2c/c/cgsvj1.c +++ b/src/map/lapack2flamec/f2c/c/cgsvj1.c @@ -272,7 +272,7 @@ int cgsvj1_(char *jobv, integer *m, integer *n, integer *n1, complex *a, integer logical rotok; extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); + int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern integer isamax_(integer *, real *, integer *); integer blskip; @@ -368,7 +368,7 @@ int cgsvj1_(char *jobv, integer *m, integer *n, integer *n1, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CGSVJ1", &i__1); + xerbla_("CGSVJ1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgtcon.c b/src/map/lapack2flamec/f2c/c/cgtcon.c index baa7e0c6b..901542e8a 100644 --- a/src/map/lapack2flamec/f2c/c/cgtcon.c +++ b/src/map/lapack2flamec/f2c/c/cgtcon.c @@ -150,7 +150,7 @@ int cgtcon_(char *norm, integer *n, complex *dl, complex * d__, complex *du, com extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; logical onenrm; extern /* Subroutine */ @@ -203,7 +203,7 @@ int cgtcon_(char *norm, integer *n, complex *dl, complex * d__, complex *du, com if (*info != 0) { i__1 = -(*info); - xerbla_("CGTCON", &i__1); + xerbla_("CGTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgtrfs.c b/src/map/lapack2flamec/f2c/c/cgtrfs.c index 7ec0db4fc..e008a3317 100644 --- a/src/map/lapack2flamec/f2c/c/cgtrfs.c +++ b/src/map/lapack2flamec/f2c/c/cgtrfs.c @@ -239,7 +239,7 @@ int cgtrfs_(char *trans, integer *n, integer *nrhs, complex * dl, complex *d__, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1]; extern /* Subroutine */ @@ -318,7 +318,7 @@ int cgtrfs_(char *trans, integer *n, integer *nrhs, complex * dl, complex *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("CGTRFS", &i__1); + xerbla_("CGTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgtsv.c b/src/map/lapack2flamec/f2c/c/cgtsv.c index 1dcb9b09b..ede052591 100644 --- a/src/map/lapack2flamec/f2c/c/cgtsv.c +++ b/src/map/lapack2flamec/f2c/c/cgtsv.c @@ -133,7 +133,7 @@ int cgtsv_(integer *n, integer *nrhs, complex *dl, complex * d__, complex *du, c integer j, k; complex temp, mult; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -180,7 +180,7 @@ int cgtsv_(integer *n, integer *nrhs, complex *dl, complex * d__, complex *du, c if (*info != 0) { i__1 = -(*info); - xerbla_("CGTSV ", &i__1); + xerbla_("CGTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgtsvx.c b/src/map/lapack2flamec/f2c/c/cgtsvx.c index 0e9e7ca89..b27f70de5 100644 --- a/src/map/lapack2flamec/f2c/c/cgtsvx.c +++ b/src/map/lapack2flamec/f2c/c/cgtsvx.c @@ -305,7 +305,7 @@ int cgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, complex *dl, co extern real slamch_(char *), clangt_(char *, integer *, complex *, complex *, complex *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), cgtcon_(char *, integer *, complex *, complex *, complex *, complex *, integer *, real *, real *, complex *, integer *), xerbla_(char *, integer *), cgtrfs_(char *, integer *, integer *, complex *, complex *, complex *, complex *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), cgttrf_(integer *, complex *, complex *, complex *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), cgtcon_(char *, integer *, complex *, complex *, complex *, complex *, integer *, real *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgtrfs_(char *, integer *, integer *, complex *, complex *, complex *, complex *, complex *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), cgttrf_(integer *, complex *, complex *, complex *, complex *, integer *, integer *); logical notran; extern /* Subroutine */ int cgttrs_(char *, integer *, integer *, complex *, complex *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -379,7 +379,7 @@ int cgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, complex *dl, co if (*info != 0) { i__1 = -(*info); - xerbla_("CGTSVX", &i__1); + xerbla_("CGTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgttrf.c b/src/map/lapack2flamec/f2c/c/cgttrf.c index fe8ca16f5..c29a398ad 100644 --- a/src/map/lapack2flamec/f2c/c/cgttrf.c +++ b/src/map/lapack2flamec/f2c/c/cgttrf.c @@ -135,7 +135,7 @@ int cgttrf_(integer *n, complex *dl, complex *d__, complex * du, complex *du2, i integer i__; complex fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -170,7 +170,7 @@ int cgttrf_(integer *n, complex *dl, complex *d__, complex * du, complex *du2, i { *info = -1; i__1 = -(*info); - xerbla_("CGTTRF", &i__1); + xerbla_("CGTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cgttrs.c b/src/map/lapack2flamec/f2c/c/cgttrs.c index fa881832b..108d7a46f 100644 --- a/src/map/lapack2flamec/f2c/c/cgttrs.c +++ b/src/map/lapack2flamec/f2c/c/cgttrs.c @@ -145,7 +145,7 @@ int cgttrs_(char *trans, integer *n, integer *nrhs, complex * dl, complex *d__, /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int cgtts2_(integer *, integer *, integer *, complex *, complex *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int cgtts2_(integer *, integer *, integer *, complex *, complex *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer itrans; logical notran; @@ -198,7 +198,7 @@ int cgttrs_(char *trans, integer *n, integer *nrhs, complex * dl, complex *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("CGTTRS", &i__1); + xerbla_("CGTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chb2st_kernels.c b/src/map/lapack2flamec/f2c/c/chb2st_kernels.c index b4df25964..1d4fd406e 100644 --- a/src/map/lapack2flamec/f2c/c/chb2st_kernels.c +++ b/src/map/lapack2flamec/f2c/c/chb2st_kernels.c @@ -183,7 +183,6 @@ int chb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in logical upper; extern /* Subroutine */ int clarfg_(integer *, complex *, complex *, integer *, complex *); - integer ajeter; extern /* Subroutine */ int clarfx_(char *, integer *, integer *, complex *, complex *, complex *, integer *, complex *), clarfy_( char *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); integer ofdpos, taupos; @@ -215,7 +214,6 @@ int chb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in --tau; --work; /* Function Body */ - ajeter = *ib + *ldvt; upper = lsame_(uplo, "U"); if (upper) { diff --git a/src/map/lapack2flamec/f2c/c/chbev.c b/src/map/lapack2flamec/f2c/c/chbev.c index 2f0e9b5fa..5310dc3a7 100644 --- a/src/map/lapack2flamec/f2c/c/chbev.c +++ b/src/map/lapack2flamec/f2c/c/chbev.c @@ -179,7 +179,7 @@ int chbev_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, integer extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indrwk; extern /* Subroutine */ @@ -247,7 +247,7 @@ int chbev_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEV ", &i__1); + xerbla_("CHBEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbev_2stage.c b/src/map/lapack2flamec/f2c/c/chbev_2stage.c index d2398de4a..731686a4e 100644 --- a/src/map/lapack2flamec/f2c/c/chbev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chbev_2stage.c @@ -248,7 +248,7 @@ int chbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indwrk, indrwk; extern /* Subroutine */ @@ -342,7 +342,7 @@ int chbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEV_2STAGE ", &i__1); + xerbla_("CHBEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbevd.c b/src/map/lapack2flamec/f2c/c/chbevd.c index 206147712..4e158ba94 100644 --- a/src/map/lapack2flamec/f2c/c/chbevd.c +++ b/src/map/lapack2flamec/f2c/c/chbevd.c @@ -265,7 +265,7 @@ int chbevd_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, intege int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indwrk, liwmin; extern /* Subroutine */ @@ -381,7 +381,7 @@ int chbevd_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEVD", &i__1); + xerbla_("CHBEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbevd_2stage.c b/src/map/lapack2flamec/f2c/c/chbevd_2stage.c index 78adc2dd1..14f1ed014 100644 --- a/src/map/lapack2flamec/f2c/c/chbevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chbevd_2stage.c @@ -315,7 +315,7 @@ int chbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indrwk, liwmin; extern /* Subroutine */ @@ -438,7 +438,7 @@ int chbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, complex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEVD_2STAGE", &i__1); + xerbla_("CHBEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbevx.c b/src/map/lapack2flamec/f2c/c/chbevx.c index c9ac42895..de5784350 100644 --- a/src/map/lapack2flamec/f2c/c/chbevx.c +++ b/src/map/lapack2flamec/f2c/c/chbevx.c @@ -316,7 +316,7 @@ int chbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, comple int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indiwk, indisp; extern /* Subroutine */ @@ -430,7 +430,7 @@ int chbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEVX", &i__1); + xerbla_("CHBEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbevx_2stage.c b/src/map/lapack2flamec/f2c/c/chbevx_2stage.c index 0775d8bf1..1ec7f8023 100644 --- a/src/map/lapack2flamec/f2c/c/chbevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chbevx_2stage.c @@ -392,7 +392,7 @@ int chbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indiwk, indisp; extern /* Subroutine */ @@ -531,7 +531,7 @@ int chbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, if (*info != 0) { i__1 = -(*info); - xerbla_("CHBEVX_2STAGE", &i__1); + xerbla_("CHBEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbgst.c b/src/map/lapack2flamec/f2c/c/chbgst.c index 0fd889f1f..8b678abdd 100644 --- a/src/map/lapack2flamec/f2c/c/chbgst.c +++ b/src/map/lapack2flamec/f2c/c/chbgst.c @@ -201,7 +201,7 @@ int chbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, comple int cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); logical upper, wantx; extern /* Subroutine */ - int clar2v_(integer *, complex *, complex *, complex *, integer *, real *, complex *, integer *), clacgv_( integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_( complex *, complex *, real *, complex *, complex *), xerbla_(char *, integer *), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *); + int clar2v_(integer *, complex *, complex *, complex *, integer *, real *, complex *, integer *), clacgv_( integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_( complex *, complex *, real *, complex *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *); logical update; extern /* Subroutine */ int clartv_(integer *, complex *, integer *, complex *, integer *, real *, complex *, integer *); @@ -244,6 +244,7 @@ int chbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, comple ka1 = *ka + 1; kb1 = *kb + 1; *info = 0; + j2 = 0; if (! wantx && ! lsame_(vect, "N")) { *info = -1; @@ -279,7 +280,7 @@ int chbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CHBGST", &i__1); + xerbla_("CHBGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbgv.c b/src/map/lapack2flamec/f2c/c/chbgv.c index b75cf22df..cbefc72e2 100644 --- a/src/map/lapack2flamec/f2c/c/chbgv.c +++ b/src/map/lapack2flamec/f2c/c/chbgv.c @@ -194,7 +194,7 @@ int chbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, complex integer iinfo; logical upper, wantz; extern /* Subroutine */ - int chbtrd_(char *, char *, integer *, integer *, complex *, integer *, real *, real *, complex *, integer *, complex *, integer *), chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), xerbla_(char *, integer *), cpbstf_(char *, integer *, integer *, complex *, integer *, integer *); + int chbtrd_(char *, char *, integer *, integer *, complex *, integer *, real *, real *, complex *, integer *, complex *, integer *), chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbstf_(char *, integer *, integer *, complex *, integer *, integer *); integer indwrk; extern /* Subroutine */ int csteqr_(char *, integer *, real *, real *, complex *, integer *, real *, integer *), ssterf_(integer *, real *, real *, integer *); @@ -267,7 +267,7 @@ int chbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CHBGV ", &i__1); + xerbla_("CHBGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbgvd.c b/src/map/lapack2flamec/f2c/c/chbgvd.c index 9397cc6a9..3d4e92107 100644 --- a/src/map/lapack2flamec/f2c/c/chbgvd.c +++ b/src/map/lapack2flamec/f2c/c/chbgvd.c @@ -281,7 +281,7 @@ int chbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, comple logical wantz; integer indwk2; extern /* Subroutine */ - int cstedc_(char *, integer *, real *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *, integer *), chbtrd_(char *, char *, integer *, integer *, complex *, integer *, real *, real *, complex *, integer *, complex *, integer *), chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cpbstf_(char *, integer *, integer *, complex *, integer *, integer *); + int cstedc_(char *, integer *, real *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *, integer *), chbtrd_(char *, char *, integer *, integer *, complex *, integer *, real *, real *, complex *, integer *, complex *, integer *), chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbstf_(char *, integer *, integer *, complex *, integer *, integer *); integer indwrk, liwmin; extern /* Subroutine */ int ssterf_(integer *, real *, real *, integer *); @@ -401,7 +401,7 @@ int chbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CHBGVD", &i__1); + xerbla_("CHBGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbgvx.c b/src/map/lapack2flamec/f2c/c/chbgvx.c index 35d6292c0..6f3e40bfc 100644 --- a/src/map/lapack2flamec/f2c/c/chbgvx.c +++ b/src/map/lapack2flamec/f2c/c/chbgvx.c @@ -330,7 +330,7 @@ int chbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege int chbtrd_(char *, char *, integer *, integer *, complex *, integer *, real *, real *, complex *, integer *, complex *, integer *); logical valeig; extern /* Subroutine */ - int chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cpbstf_( char *, integer *, integer *, complex *, integer *, integer *); + int chbgst_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbstf_( char *, integer *, integer *, complex *, integer *, integer *); integer indiwk, indisp; extern /* Subroutine */ int cstein_(integer *, real *, real *, integer *, real *, integer *, integer *, complex *, integer *, real *, integer *, integer *, integer *); @@ -453,7 +453,7 @@ int chbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CHBGVX", &i__1); + xerbla_("CHBGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chbtrd.c b/src/map/lapack2flamec/f2c/c/chbtrd.c index 89cc80a9c..a6834279f 100644 --- a/src/map/lapack2flamec/f2c/c/chbtrd.c +++ b/src/map/lapack2flamec/f2c/c/chbtrd.c @@ -208,7 +208,7 @@ int chbtrd_(char *vect, char *uplo, integer *n, integer *kd, complex *ab, intege int clar2v_(integer *, complex *, complex *, complex *, integer *, real *, complex *, integer *), clacgv_( integer *, complex *, integer *); integer iqaend; extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(char *, integer *), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *), clartv_(integer *, complex *, integer *, complex *, integer *, real *, complex *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clargv_(integer *, complex *, integer *, complex *, integer *, real *, integer *), clartv_(integer *, complex *, integer *, complex *, integer *, real *, complex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -276,7 +276,7 @@ int chbtrd_(char *vect, char *uplo, integer *n, integer *kd, complex *ab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CHBTRD", &i__1); + xerbla_("CHBTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/checon.c b/src/map/lapack2flamec/f2c/c/checon.c index ed6b46cc4..8b6e1c910 100644 --- a/src/map/lapack2flamec/f2c/c/checon.c +++ b/src/map/lapack2flamec/f2c/c/checon.c @@ -133,7 +133,7 @@ int checon_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, rea integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int chetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -188,7 +188,7 @@ int checon_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, rea if (*info != 0) { i__1 = -(*info); - xerbla_("CHECON", &i__1); + xerbla_("CHECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/checon_3.c b/src/map/lapack2flamec/f2c/c/checon_3.c index ae03cc95c..35c30ac1c 100644 --- a/src/map/lapack2flamec/f2c/c/checon_3.c +++ b/src/map/lapack2flamec/f2c/c/checon_3.c @@ -175,7 +175,7 @@ int checon_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int chetrs_3_(char *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -231,7 +231,7 @@ int checon_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int if (*info != 0) { i__1 = -(*info); - xerbla_("CHECON_3", &i__1); + xerbla_("CHECON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/checon_rook.c b/src/map/lapack2flamec/f2c/c/checon_rook.c index 5f48ca677..a5f2499a7 100644 --- a/src/map/lapack2flamec/f2c/c/checon_rook.c +++ b/src/map/lapack2flamec/f2c/c/checon_rook.c @@ -149,7 +149,7 @@ int checon_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -202,7 +202,7 @@ int checon_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CHECON_ROOK", &i__1); + xerbla_("CHECON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheequb.c b/src/map/lapack2flamec/f2c/c/cheequb.c index 9f60de1e6..8af7d4c87 100644 --- a/src/map/lapack2flamec/f2c/c/cheequb.c +++ b/src/map/lapack2flamec/f2c/c/cheequb.c @@ -143,7 +143,7 @@ int cheequb_(char *uplo, integer *n, complex *a, integer * lda, real *s, real *s real sumsq; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int classq_(integer *, complex *, integer *, real *, real *); @@ -195,7 +195,7 @@ int cheequb_(char *uplo, integer *n, complex *a, integer * lda, real *s, real *s if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEQUB", &i__1); + xerbla_("CHEEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheev.c b/src/map/lapack2flamec/f2c/c/cheev.c index eb2a4241b..c3d26157d 100644 --- a/src/map/lapack2flamec/f2c/c/cheev.c +++ b/src/map/lapack2flamec/f2c/c/cheev.c @@ -173,7 +173,7 @@ int cheev_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, real *w real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau, indwrk; extern /* Subroutine */ @@ -251,7 +251,7 @@ int cheev_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, real *w if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEV ", &i__1); + xerbla_("CHEEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheev_2stage.c b/src/map/lapack2flamec/f2c/c/cheev_2stage.c index d1b5e0cda..e8633de15 100644 --- a/src/map/lapack2flamec/f2c/c/cheev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/cheev_2stage.c @@ -227,7 +227,7 @@ int cheev_2stage_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau, indwrk; extern /* Subroutine */ @@ -302,7 +302,7 @@ int cheev_2stage_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEV_2STAGE ", &i__1); + xerbla_("CHEEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevd.c b/src/map/lapack2flamec/f2c/c/cheevd.c index bd2473bf1..ccab03ec9 100644 --- a/src/map/lapack2flamec/f2c/c/cheevd.c +++ b/src/map/lapack2flamec/f2c/c/cheevd.c @@ -235,7 +235,7 @@ int cheevd_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, real * real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau, indrwk, indwrk, liwmin; extern /* Subroutine */ @@ -350,7 +350,7 @@ int cheevd_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVD", &i__1); + xerbla_("CHEEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevd_2stage.c b/src/map/lapack2flamec/f2c/c/cheevd_2stage.c index e3833688a..70b31a0e8 100644 --- a/src/map/lapack2flamec/f2c/c/cheevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/cheevd_2stage.c @@ -295,7 +295,7 @@ int cheevd_2stage_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau, indrwk, indwrk, liwmin; extern /* Subroutine */ @@ -406,7 +406,7 @@ int cheevd_2stage_(char *jobz, char *uplo, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVD_2STAGE", &i__1); + xerbla_("CHEEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevr.c b/src/map/lapack2flamec/f2c/c/cheevr.c index d394188e7..36d06b583 100644 --- a/src/map/lapack2flamec/f2c/c/cheevr.c +++ b/src/map/lapack2flamec/f2c/c/cheevr.c @@ -392,7 +392,7 @@ int cheevr_(char *jobz, char *range, char *uplo, integer *n, complex *a, integer real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -543,7 +543,7 @@ int cheevr_(char *jobz, char *range, char *uplo, integer *n, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVR", &i__1); + xerbla_("CHEEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevr_2stage.c b/src/map/lapack2flamec/f2c/c/cheevr_2stage.c index d6a2e69c5..7a3ea306b 100644 --- a/src/map/lapack2flamec/f2c/c/cheevr_2stage.c +++ b/src/map/lapack2flamec/f2c/c/cheevr_2stage.c @@ -453,7 +453,7 @@ int cheevr_2stage_(char *jobz, char *range, char *uplo, integer *n, complex *a, real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -597,7 +597,7 @@ int cheevr_2stage_(char *jobz, char *range, char *uplo, integer *n, complex *a, if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVR_2STAGE", &i__1); + xerbla_("CHEEVR_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevx.c b/src/map/lapack2flamec/f2c/c/cheevx.c index 632fe48a0..597df4a6d 100644 --- a/src/map/lapack2flamec/f2c/c/cheevx.c +++ b/src/map/lapack2flamec/f2c/c/cheevx.c @@ -293,7 +293,7 @@ int cheevx_(char *jobz, char *range, char *uplo, integer *n, complex *a, integer real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indiwk, indisp, indtau; extern /* Subroutine */ @@ -347,6 +347,7 @@ int cheevx_(char *jobz, char *range, char *uplo, integer *n, complex *a, integer valeig = lsame_(range, "V"); indeig = lsame_(range, "I"); lquery = *lwork == -1; + lwkopt = 0; *info = 0; if (! (wantz || lsame_(jobz, "N"))) { @@ -427,7 +428,7 @@ int cheevx_(char *jobz, char *range, char *uplo, integer *n, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVX", &i__1); + xerbla_("CHEEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cheevx_2stage.c b/src/map/lapack2flamec/f2c/c/cheevx_2stage.c index b9717db7f..89c3e8cbc 100644 --- a/src/map/lapack2flamec/f2c/c/cheevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/cheevx_2stage.c @@ -354,7 +354,7 @@ int cheevx_2stage_(char *jobz, char *range, char *uplo, integer *n, complex *a, int csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indiwk, indisp, indtau; extern /* Subroutine */ @@ -483,7 +483,7 @@ int cheevx_2stage_(char *jobz, char *range, char *uplo, integer *n, complex *a, if (*info != 0) { i__1 = -(*info); - xerbla_("CHEEVX_2STAGE", &i__1); + xerbla_("CHEEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chegv.c b/src/map/lapack2flamec/f2c/c/chegv.c index a9d68c71c..d78c1c46d 100644 --- a/src/map/lapack2flamec/f2c/c/chegv.c +++ b/src/map/lapack2flamec/f2c/c/chegv.c @@ -209,7 +209,7 @@ int chegv_(integer *itype, char *jobz, char *uplo, integer * n, complex *a, inte int chegst_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), cpotrf_( char *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpotrf_( char *, integer *, complex *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.0) -- */ @@ -292,7 +292,7 @@ int chegv_(integer *itype, char *jobz, char *uplo, integer * n, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGV ", &i__1); + xerbla_("CHEGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chegv_2stage.c b/src/map/lapack2flamec/f2c/c/chegv_2stage.c index 74489bb6f..ae2979423 100644 --- a/src/map/lapack2flamec/f2c/c/chegv_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chegv_2stage.c @@ -264,7 +264,7 @@ int chegv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, complex *a integer lwtrd; logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), chegst_( integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *), cpotrf_(char *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chegst_( integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *), cpotrf_(char *, integer *, complex *, integer *, integer *); logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -343,7 +343,7 @@ int chegv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGV_2STAGE ", &i__1); + xerbla_("CHEGV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chegvd.c b/src/map/lapack2flamec/f2c/c/chegvd.c index 8ba1c8b02..c6f54bbc9 100644 --- a/src/map/lapack2flamec/f2c/c/chegvd.c +++ b/src/map/lapack2flamec/f2c/c/chegvd.c @@ -268,7 +268,7 @@ int chegvd_(integer *itype, char *jobz, char *uplo, integer * n, complex *a, int integer lropt; logical wantz; extern /* Subroutine */ - int cheevd_(char *, char *, integer *, complex *, integer *, real *, complex *, integer *, real *, integer *, integer *, integer *, integer *), chegst_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *), cpotrf_( char *, integer *, complex *, integer *, integer *); + int cheevd_(char *, char *, integer *, complex *, integer *, real *, complex *, integer *, real *, integer *, integer *, integer *, integer *), chegst_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpotrf_( char *, integer *, complex *, integer *, integer *); integer liwmin, lrwmin; logical lquery; /* -- LAPACK driver routine -- */ @@ -374,7 +374,7 @@ int chegvd_(integer *itype, char *jobz, char *uplo, integer * n, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGVD", &i__1); + xerbla_("CHEGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chegvx.c b/src/map/lapack2flamec/f2c/c/chegvx.c index de67820a7..9072b5057 100644 --- a/src/map/lapack2flamec/f2c/c/chegvx.c +++ b/src/map/lapack2flamec/f2c/c/chegvx.c @@ -323,7 +323,7 @@ int chegvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, co int chegst_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), cheevx_( char *, char *, char *, integer *, complex *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *), cpotrf_(char *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cheevx_( char *, char *, char *, integer *, complex *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *), cpotrf_(char *, integer *, complex *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.0) -- */ @@ -446,7 +446,7 @@ int chegvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, co if (*info != 0) { i__1 = -(*info); - xerbla_("CHEGVX", &i__1); + xerbla_("CHEGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cherfs.c b/src/map/lapack2flamec/f2c/c/cherfs.c index 4c409f852..25b7d84ff 100644 --- a/src/map/lapack2flamec/f2c/c/cherfs.c +++ b/src/map/lapack2flamec/f2c/c/cherfs.c @@ -222,7 +222,7 @@ int cherfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -303,7 +303,7 @@ int cherfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CHERFS", &i__1); + xerbla_("CHERFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cherfsx.c b/src/map/lapack2flamec/f2c/c/cherfsx.c index aaee92e9b..1a4ec7b61 100644 --- a/src/map/lapack2flamec/f2c/c/cherfsx.c +++ b/src/map/lapack2flamec/f2c/c/cherfsx.c @@ -431,7 +431,7 @@ int cherfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in int checon_(char *, integer *, complex *, integer *, integer *, real *, real *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaprec_(char *); integer ithresh, n_norms__; real rthresh; @@ -578,7 +578,7 @@ int cherfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CHERFSX", &i__1); + xerbla_("CHERFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesv.c b/src/map/lapack2flamec/f2c/c/chesv.c index ffe19cc5f..30e216d3c 100644 --- a/src/map/lapack2flamec/f2c/c/chesv.c +++ b/src/map/lapack2flamec/f2c/c/chesv.c @@ -179,7 +179,7 @@ int chesv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, inte integer nb; extern logical lsame_(char *, char *); extern /* Subroutine */ - int chetrf_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), xerbla_( char *, integer *); + int chetrf_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int chetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -259,7 +259,7 @@ int chesv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CHESV ", &i__1); + xerbla_("CHESV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesv_aa.c b/src/map/lapack2flamec/f2c/c/chesv_aa.c index 9167343b3..6077d9742 100644 --- a/src/map/lapack2flamec/f2c/c/chesv_aa.c +++ b/src/map/lapack2flamec/f2c/c/chesv_aa.c @@ -171,7 +171,7 @@ int chesv_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, i integer lwkopt_hetrf__, lwkopt_hetrs__; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -248,7 +248,7 @@ int chesv_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("CHESV_AA ", &i__1); + xerbla_("CHESV_AA ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/chesv_aa_2stage.c index 7c10991f0..13d21e5c8 100644 --- a/src/map/lapack2flamec/f2c/c/chesv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chesv_aa_2stage.c @@ -196,7 +196,7 @@ int chesv_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; extern /* Subroutine */ @@ -272,7 +272,7 @@ int chesv_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CHESV_AA_2STAGE", &i__1); + xerbla_("CHESV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesv_rk.c b/src/map/lapack2flamec/f2c/c/chesv_rk.c index b72752565..dd4fa3494 100644 --- a/src/map/lapack2flamec/f2c/c/chesv_rk.c +++ b/src/map/lapack2flamec/f2c/c/chesv_rk.c @@ -228,7 +228,7 @@ int chesv_rk_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c int chetrf_rk_(char *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -305,7 +305,7 @@ int chesv_rk_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CHESV_RK ", &i__1); + xerbla_("CHESV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesv_rook.c b/src/map/lapack2flamec/f2c/c/chesv_rook.c index b871dc98f..4ed755d1a 100644 --- a/src/map/lapack2flamec/f2c/c/chesv_rook.c +++ b/src/map/lapack2flamec/f2c/c/chesv_rook.c @@ -214,7 +214,7 @@ int chesv_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, int chetrf_rook_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), chetrs_rook_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -290,7 +290,7 @@ int chesv_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHESV_ROOK ", &i__1); + xerbla_("CHESV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesvx.c b/src/map/lapack2flamec/f2c/c/chesvx.c index 33d2cd433..1007d4af9 100644 --- a/src/map/lapack2flamec/f2c/c/chesvx.c +++ b/src/map/lapack2flamec/f2c/c/chesvx.c @@ -300,7 +300,7 @@ int chesvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte int cherfs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), chetrf_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.1) -- */ @@ -408,7 +408,7 @@ int chesvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CHESVX", &i__1); + xerbla_("CHESVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chesvxx.c b/src/map/lapack2flamec/f2c/c/chesvxx.c index b27928079..c7edd6601 100644 --- a/src/map/lapack2flamec/f2c/c/chesvxx.c +++ b/src/map/lapack2flamec/f2c/c/chesvxx.c @@ -530,7 +530,7 @@ int chesvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int chetrf_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int chetrf_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_( char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -680,7 +680,7 @@ int chesvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CHESVXX", &i__1); + xerbla_("CHESVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetd2.c b/src/map/lapack2flamec/f2c/c/chetd2.c index 86b34804e..f2f98b973 100644 --- a/src/map/lapack2flamec/f2c/c/chetd2.c +++ b/src/map/lapack2flamec/f2c/c/chetd2.c @@ -191,7 +191,7 @@ int chetd2_(char *uplo, integer *n, complex *a, integer *lda, real *d__, real *e int chemv_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer * ), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -237,7 +237,7 @@ int chetd2_(char *uplo, integer *n, complex *a, integer *lda, real *d__, real *e if (*info != 0) { i__1 = -(*info); - xerbla_("CHETD2", &i__1); + xerbla_("CHETD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetf2.c b/src/map/lapack2flamec/f2c/c/chetf2.c index a5b66e61a..423ce7405 100644 --- a/src/map/lapack2flamec/f2c/c/chetf2.c +++ b/src/map/lapack2flamec/f2c/c/chetf2.c @@ -218,7 +218,7 @@ int chetf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int real absakk; extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax; extern logical sisnan_(real *); real rowmax; @@ -254,6 +254,8 @@ int chetf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -270,7 +272,7 @@ int chetf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int if (*info != 0) { i__1 = -(*info); - xerbla_("CHETF2", &i__1); + xerbla_("CHETF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetf2_rk.c b/src/map/lapack2flamec/f2c/c/chetf2_rk.c index 9829b5ab6..9af0312f7 100644 --- a/src/map/lapack2flamec/f2c/c/chetf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/chetf2_rk.c @@ -278,7 +278,7 @@ int chetf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -313,6 +313,8 @@ int chetf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -329,7 +331,7 @@ int chetf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CHETF2_RK", &i__1); + xerbla_("CHETF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetf2_rook.c b/src/map/lapack2flamec/f2c/c/chetf2_rook.c index 5bf1fe422..28d9abece 100644 --- a/src/map/lapack2flamec/f2c/c/chetf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/chetf2_rook.c @@ -228,7 +228,7 @@ int chetf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -262,6 +262,8 @@ int chetf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -278,7 +280,7 @@ int chetf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CHETF2_ROOK", &i__1); + xerbla_("CHETF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrd.c b/src/map/lapack2flamec/f2c/c/chetrd.c index a3310e793..d01d49660 100644 --- a/src/map/lapack2flamec/f2c/c/chetrd.c +++ b/src/map/lapack2flamec/f2c/c/chetrd.c @@ -201,7 +201,7 @@ int chetrd_(char *uplo, integer *n, complex *a, integer *lda, real *d__, real *e integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int chetd2_(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer *, real *, complex *, complex *, integer *), xerbla_(char *, integer *); + int chetd2_(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer *, real *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -264,7 +264,7 @@ int chetrd_(char *uplo, integer *n, complex *a, integer *lda, real *d__, real *e if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD", &i__1); + xerbla_("CHETRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrd_2stage.c b/src/map/lapack2flamec/f2c/c/chetrd_2stage.c index d6da445df..eacd42906 100644 --- a/src/map/lapack2flamec/f2c/c/chetrd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chetrd_2stage.c @@ -244,9 +244,9 @@ int chetrd_2stage_(char *vect, char *uplo, integer *n, complex *a, integer *lda, integer lwrk, wpos; extern logical lsame_(char *, char *); integer abpos, lhmin, lwmin; - logical wantq, upper; + logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -277,7 +277,6 @@ int chetrd_2stage_(char *vect, char *uplo, integer *n, complex *a, integer *lda, --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "V"); upper = lsame_(uplo, "U"); lquery = *lwork == -1 || *lhous2 == -1; /* Determine the block size, the workspace size and the hous size. */ @@ -321,7 +320,7 @@ int chetrd_2stage_(char *vect, char *uplo, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD_2STAGE", &i__1); + xerbla_("CHETRD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -347,7 +346,7 @@ int chetrd_2stage_(char *vect, char *uplo, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD_HE2HB", &i__1); + xerbla_("CHETRD_HE2HB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -355,7 +354,7 @@ int chetrd_2stage_(char *vect, char *uplo, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD_HB2ST", &i__1); + xerbla_("CHETRD_HB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrd_hb2st.c b/src/map/lapack2flamec/f2c/c/chetrd_hb2st.c index 59f4e3722..65ecc759f 100644 --- a/src/map/lapack2flamec/f2c/c/chetrd_hb2st.c +++ b/src/map/lapack2flamec/f2c/c/chetrd_hb2st.c @@ -1,11 +1,12 @@ /* ../netlib/v3.9.0/chetrd_hb2st.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#ifdef FLA_OPENMP_MULTITHREADING +#include +#endif static complex c_b1 = -{ - 0.f,0.f -} -; + { + 0.f, 0.f}; static integer c__2 = 2; static integer c_n1 = -1; static integer c__3 = 3; @@ -68,7 +69,7 @@ static integer c__4 = 4; /* > VECT is CHARACTER*1 */ /* > = 'N': No need for the Housholder representation, */ /* > and thus LHOUS is of size fla_max(1, 4*N); -*/ + */ /* > = 'V': the Householder representation is needed to */ /* > either generate or to apply Q later on, */ /* > then LHOUS is to be queried and computed. */ @@ -79,7 +80,7 @@ static integer c__4 = 4; /* > \verbatim */ /* > UPLO is CHARACTER*1 */ /* > = 'U': Upper triangle of A is stored; -*/ + */ /* > = 'L': Lower triangle of A is stored. */ /* > \endverbatim */ /* > */ @@ -104,7 +105,7 @@ static integer c__4 = 4; /* > j-th column of A is stored in the j-th column of the array AB */ /* > as follows: */ /* > if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for fla_max(1,j-kd)<=i<=j; -*/ + */ /* > if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=fla_min(n,j+kd). */ /* > On exit, the diagonal elements of AB are overwritten by the */ /* > diagonal elements of the tridiagonal matrix T; @@ -231,15 +232,15 @@ the routine */ /* > */ /* ===================================================================== */ /* Subroutine */ -int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, real *d__, real * e, complex *hous, integer *lhous, complex *work, integer *lwork, integer *info) +int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, real *d__, real *e, complex *hous, integer *lhous, complex *work, integer *lwork, integer *info) { AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_5); #if LF_AOCL_DTL_LOG_ENABLE char buffer[256]; #if FLA_ENABLE_ILP64 - snprintf(buffer, 256,"chetrd_hb2st inputs: stage1 %c, vect %c, uplo %c, n %lld, kd %lld, ldab %lld, lhous %lld, lwork %lld",*stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); + snprintf(buffer, 256, "chetrd_hb2st inputs: stage1 %c, vect %c, uplo %c, n %lld, kd %lld, ldab %lld, lhous %lld, lwork %lld", *stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); #else - snprintf(buffer, 256,"chetrd_hb2st inputs: stage1 %c, vect %c, uplo %c, n %d, kd %d, ldab %d, lhous %d, lwork %d",*stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); + snprintf(buffer, 256, "chetrd_hb2st inputs: stage1 %c, vect %c, uplo %c, n %d, kd %d, ldab %d, lhous %d, lwork %d", *stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); #endif AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif @@ -249,30 +250,34 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, /* Builtin functions */ double c_abs(complex *); /* Local variables */ - integer abofdpos, nthreads, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv; + integer abofdpos, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv; complex tmp; integer stt, inda; extern integer ilaenv2stage_(integer *, char *, char *, integer *, integer *, integer *, integer *); - integer thed, indv, myid, indw, apos, dpos, edind, debug; + integer thed, indv, myid, indw, apos, dpos, edind; extern logical lsame_(char *, char *); - integer lhmin, sicev, sizea, shift, stind, colpt, lwmin, awpos; + integer lhmin, sizea, shift, stind, colpt, lwmin, awpos; logical wantq, upper; integer grsiz, ttype; extern /* Subroutine */ - int chb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); + int + chb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); integer abdpos; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int + clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), + claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), + xerbla_(const char *srname, const integer *info, ftnlen srname_len); +#ifdef FLA_OPENMP_MULTITHREADING + extern /* Function */ + int fla_thread_get_num_threads(); +#endif integer thgrid, thgrnb, indtau; real abstmp; integer ofdpos; logical lquery, afters1; - extern /* Subroutine */ - int f90_exit_(void); integer ceiltmp, sweepid, nbtiles, sizetau, thgrsiz; - /* #if defined(_OPENMP) */ - /* use omp_lib */ - /* #endif */ + int nthreads; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -304,7 +309,6 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, --hous; --work; /* Function Body */ - debug = 0; *info = 0; afters1 = lsame_(stage1, "Y"); wantq = lsame_(vect, "V"); @@ -314,15 +318,15 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ib = ilaenv2stage_(&c__2, "CHETRD_HB2ST", vect, n, kd, &c_n1, &c_n1); lhmin = ilaenv2stage_(&c__3, "CHETRD_HB2ST", vect, n, kd, &ib, &c_n1); lwmin = ilaenv2stage_(&c__4, "CHETRD_HB2ST", vect, n, kd, &ib, &c_n1); - if (! afters1 && ! lsame_(stage1, "N")) + if (!afters1 && !lsame_(stage1, "N")) { *info = -1; } - else if (! lsame_(vect, "N")) + else if (!lsame_(vect, "N")) { *info = -2; } - else if (! upper && ! lsame_(uplo, "L")) + else if (!upper && !lsame_(uplo, "L")) { *info = -3; } @@ -338,25 +342,25 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { *info = -7; } - else if (*lhous < lhmin && ! lquery) + else if (*lhous < lhmin && !lquery) { *info = -11; } - else if (*lwork < lwmin && ! lquery) + else if (*lwork < lwmin && !lquery) { *info = -13; } if (*info == 0) { - hous[1].r = (real) lhmin; + hous[1].r = (real)lhmin; hous[1].i = 0.f; // , expr subst - work[1].r = (real) lwmin; + work[1].r = (real)lwmin; work[1].i = 0.f; // , expr subst } if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD_HB2ST", &i__1); + xerbla_("CHETRD_HB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -378,14 +382,12 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, /* Determine pointer position */ ldv = *kd + ib; sizetau = *n << 1; - sicev = *n << 1; indtau = 1; indv = indtau + sizetau; lda = (*kd << 1) + 1; sizea = lda * *n; inda = 1; indw = inda + sizea; - nthreads = 1; tid = 0; if (upper) { @@ -414,8 +416,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abdpos + i__ * ab_dim1; d__[i__] = ab[i__2].r; @@ -423,8 +425,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, } i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = 0.f; /* L40: */ @@ -449,8 +451,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abdpos + i__ * ab_dim1; d__[i__] = ab[i__2].r; @@ -461,8 +463,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abofdpos + (i__ + 1) * ab_dim1; tmp.r = ab[i__2].r; @@ -503,8 +505,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abofdpos + i__ * ab_dim1; tmp.r = ab[i__2].r; @@ -575,137 +577,137 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ++thgrnb; } i__1 = *kd + 1; - clacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda) ; + clacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda); claset_("A", kd, n, &c_b1, &c_b1, &work[awpos], &lda); + /* openMP parallelisation start here */ - /* #if defined(_OPENMP) */ - /* !$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND ) */ - /* !$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) */ - /* !$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND ) */ - /* !$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK) */ - /* !$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA ) */ - /* !$OMP$ SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT ) */ - /* !$OMP MASTER */ - /* #endif */ - /* main bulge chasing loop */ - i__1 = thgrnb; - for (thgrid = 1; - thgrid <= i__1; - ++thgrid) + nthreads = 1; +#ifdef FLA_OPENMP_MULTITHREADING + nthreads = fla_thread_get_num_threads(); +#pragma omp parallel num_threads(nthreads) private(tid, thgrid, blklastind) \ + private(thed, i__, m, k, st, ed, stt, sweepid, myid, ttype, colpt, stind, edind) \ + shared(uplo, wantq, indv, indtau, hous, work, \ + n, kd, ib, nbtiles, lda, ldv, inda, stepercol, thgrnb, thgrsiz, grsiz, shift) { - stt = (thgrid - 1) * thgrsiz + 1; - /* Computing MIN */ - i__2 = stt + thgrsiz - 1; - i__3 = *n - 1; // , expr subst - thed = fla_min(i__2,i__3); - i__2 = *n - 1; - for (i__ = stt; - i__ <= i__2; - ++i__) +#pragma omp master { - ed = fla_min(i__,thed); - if (stt > ed) - { - break; - } - i__3 = stepercol; - for (m = 1; - m <= i__3; - ++m) +#endif + /* main bulge chasing loop */ + i__1 = thgrnb; + for (thgrid = 1; + thgrid <= i__1; + ++thgrid) { - st = stt; - i__4 = ed; - for (sweepid = st; - sweepid <= i__4; - ++sweepid) + stt = (thgrid - 1) * thgrsiz + 1; + /* Computing MIN */ + i__2 = stt + thgrsiz - 1; + i__3 = *n - 1; // , expr subst + thed = fla_min(i__2, i__3); + i__2 = *n - 1; + for (i__ = stt; + i__ <= i__2; + ++i__) { - i__5 = grsiz; - for (k = 1; - k <= i__5; - ++k) + ed = fla_min(i__, thed); + if (stt > ed) { - myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; - if (myid == 1) - { - ttype = 1; - } - else - { - ttype = myid % 2 + 2; - } - if (ttype == 2) - { - colpt = myid / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - blklastind = colpt; - } - else + break; + } + i__3 = stepercol; + for (m = 1; + m <= i__3; + ++m) + { + st = stt; + i__4 = ed; + for (sweepid = st; + sweepid <= i__4; + ++sweepid) { - colpt = (myid + 1) / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - if (stind >= edind - 1 && edind == *n) - { - blklastind = *n; - } - else + i__5 = grsiz; + for (k = 1; + k <= i__5; + ++k) { - blklastind = 0; + myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; + if (myid == 1) + { + ttype = 1; + } + else + { + ttype = myid % 2 + 2; + } + if (ttype == 2) + { + colpt = myid / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + blklastind = colpt; + } + else + { + colpt = (myid + 1) / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + if (stind >= edind - 1 && edind == *n) + { + blklastind = *n; + } + else + { + blklastind = 0; + } + } + /* Call the kernel */ +#ifdef FLA_OPENMP_MULTITHREADING + if (ttype != 1) + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(in : work[myid - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + chb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } + else + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + chb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } +#else + chb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); +#endif + if (blklastind >= *n - 1) + { + ++stt; + break; + } + /* L140: */ } + /* L130: */ } - /* Call the kernel */ - /* #if defined(_OPENMP) */ - /* IF( TTYPE.NE.1 ) THEN */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(in:WORK(MYID-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ELSE */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ENDIF */ - /* #else */ - chb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, & hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); - /* #endif */ - if (blklastind >= *n - 1) - { - ++stt; - break; - } - /* L140: */ + /* L120: */ } - /* L130: */ + /* L110: */ } - /* L120: */ + /* L100: */ } - /* L110: */ - } - /* L100: */ - } - /* #if defined(_OPENMP) */ - /* !$OMP END MASTER */ - /* !$OMP END PARALLEL */ - /* #endif */ +#ifdef FLA_OPENMP_MULTITHREADING + } /* End OMP Master */ + } /* End OMP Parallel */ +#endif /* Copy the diagonal from A to D. Note that D is REAL thus only */ /* the Real part is needed, the imaginary part should be zero. */ i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = dpos + (i__ - 1) * lda; d__[i__] = work[i__2].r; @@ -717,8 +719,8 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = ofdpos + i__ * lda; e[i__] = work[i__2].r; @@ -729,17 +731,17 @@ int chetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = ofdpos + (i__ - 1) * lda; e[i__] = work[i__2].r; /* L170: */ } } - hous[1].r = (real) lhmin; + hous[1].r = (real)lhmin; hous[1].i = 0.f; // , expr subst - work[1].r = (real) lwmin; + work[1].r = (real)lwmin; work[1].i = 0.f; // , expr subst AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; diff --git a/src/map/lapack2flamec/f2c/c/chetrd_he2hb.c b/src/map/lapack2flamec/f2c/c/chetrd_he2hb.c index c47bead05..62cf6a9b2 100644 --- a/src/map/lapack2flamec/f2c/c/chetrd_he2hb.c +++ b/src/map/lapack2flamec/f2c/c/chetrd_he2hb.c @@ -275,7 +275,7 @@ int chetrd_he2hb_(char *uplo, integer *n, integer *kd, complex *a, integer *lda, integer lwmin; logical upper; extern /* Subroutine */ - int cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), cgelqf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -346,7 +346,7 @@ int chetrd_he2hb_(char *uplo, integer *n, integer *kd, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD_HE2HB", &i__1); + xerbla_("CHETRD_HE2HB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrf.c b/src/map/lapack2flamec/f2c/c/chetrf.c index 438634283..3d4cdc5ad 100644 --- a/src/map/lapack2flamec/f2c/c/chetrf.c +++ b/src/map/lapack2flamec/f2c/c/chetrf.c @@ -188,7 +188,7 @@ int chetrf_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int chetf2_(char *, integer *, complex *, integer *, integer *, integer *), clahef_(char *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); + int chetf2_(char *, integer *, complex *, integer *, integer *, integer *), clahef_(char *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -248,7 +248,7 @@ int chetrf_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRF", &i__1); + xerbla_("CHETRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrf_aa.c b/src/map/lapack2flamec/f2c/c/chetrf_aa.c index f9a185851..89b20180a 100644 --- a/src/map/lapack2flamec/f2c/c/chetrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/chetrf_aa.c @@ -150,7 +150,7 @@ int chetrf_aa_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, int ccopy_(integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -210,7 +210,7 @@ int chetrf_aa_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRF_AA", &i__1); + xerbla_("CHETRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/chetrf_aa_2stage.c index 83bf464b0..e27519d48 100644 --- a/src/map/lapack2flamec/f2c/c/chetrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chetrf_aa_2stage.c @@ -192,7 +192,7 @@ int chetrf_aa_2stage_(char *uplo, integer *n, complex *a, integer *lda, complex int ccopy_(integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int chegst_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -253,7 +253,7 @@ int chetrf_aa_2stage_(char *uplo, integer *n, complex *a, integer *lda, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRF_AA_2STAGE", &i__1); + xerbla_("CHETRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrf_rk.c b/src/map/lapack2flamec/f2c/c/chetrf_rk.c index 01a70a16a..049bd9322 100644 --- a/src/map/lapack2flamec/f2c/c/chetrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/chetrf_rk.c @@ -277,7 +277,7 @@ int chetrf_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in int cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -338,7 +338,7 @@ int chetrf_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRF_RK", &i__1); + xerbla_("CHETRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrf_rook.c b/src/map/lapack2flamec/f2c/c/chetrf_rook.c index 803b9c3d0..900d83773 100644 --- a/src/map/lapack2flamec/f2c/c/chetrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/chetrf_rook.c @@ -227,7 +227,7 @@ int chetrf_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -290,7 +290,7 @@ int chetrf_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRF_ROOK", &i__1); + xerbla_("CHETRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri.c b/src/map/lapack2flamec/f2c/c/chetri.c index 822fff341..34d7041c0 100644 --- a/src/map/lapack2flamec/f2c/c/chetri.c +++ b/src/map/lapack2flamec/f2c/c/chetri.c @@ -144,7 +144,7 @@ int chetri_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com integer kstep; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -190,7 +190,7 @@ int chetri_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI", &i__1); + xerbla_("CHETRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri2.c b/src/map/lapack2flamec/f2c/c/chetri2.c index 1ba959b5a..e4807ee37 100644 --- a/src/map/lapack2flamec/f2c/c/chetri2.c +++ b/src/map/lapack2flamec/f2c/c/chetri2.c @@ -141,7 +141,7 @@ int chetri2_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, c integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int chetri_(char *, integer *, complex *, integer *, integer *, complex *, integer *); @@ -204,7 +204,7 @@ int chetri2_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, c if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI2", &i__1); + xerbla_("CHETRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri2x.c b/src/map/lapack2flamec/f2c/c/chetri2x.c index 0e3e94120..f669d3a9e 100644 --- a/src/map/lapack2flamec/f2c/c/chetri2x.c +++ b/src/map/lapack2flamec/f2c/c/chetri2x.c @@ -159,7 +159,7 @@ int chetri2x_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, logical upper; complex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), ctrtri_( char *, char *, integer *, complex *, integer *, integer *), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctrtri_( char *, char *, integer *, complex *, integer *, integer *), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); complex u01_ip1_j__, u11_ip1_j__; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -209,7 +209,7 @@ int chetri2x_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI2X", &i__1); + xerbla_("CHETRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri_3.c b/src/map/lapack2flamec/f2c/c/chetri_3.c index 72d4cd376..ba7feee03 100644 --- a/src/map/lapack2flamec/f2c/c/chetri_3.c +++ b/src/map/lapack2flamec/f2c/c/chetri_3.c @@ -184,7 +184,7 @@ int chetri_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -243,7 +243,7 @@ int chetri_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI_3", &i__1); + xerbla_("CHETRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri_3x.c b/src/map/lapack2flamec/f2c/c/chetri_3x.c index afc5b3005..0409fcda5 100644 --- a/src/map/lapack2flamec/f2c/c/chetri_3x.c +++ b/src/map/lapack2flamec/f2c/c/chetri_3x.c @@ -197,7 +197,7 @@ int chetri_3x_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in logical upper; complex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int ctrtri_(char *, char *, integer *, complex *, integer *, integer *); @@ -251,7 +251,7 @@ int chetri_3x_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI_3X", &i__1); + xerbla_("CHETRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetri_rook.c b/src/map/lapack2flamec/f2c/c/chetri_rook.c index 2ba690a23..f8f9a64b1 100644 --- a/src/map/lapack2flamec/f2c/c/chetri_rook.c +++ b/src/map/lapack2flamec/f2c/c/chetri_rook.c @@ -157,7 +157,7 @@ int chetri_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer kstep; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -203,7 +203,7 @@ int chetri_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRI_ROOK", &i__1); + xerbla_("CHETRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs.c b/src/map/lapack2flamec/f2c/c/chetrs.c index 68ab9f71e..e6ef4a586 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs.c +++ b/src/map/lapack2flamec/f2c/c/chetrs.c @@ -143,7 +143,7 @@ int chetrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, in int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -198,7 +198,7 @@ int chetrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, in if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS", &i__1); + xerbla_("CHETRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs2.c b/src/map/lapack2flamec/f2c/c/chetrs2.c index 42b0f217c..0efcb1fa4 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs2.c +++ b/src/map/lapack2flamec/f2c/c/chetrs2.c @@ -149,7 +149,7 @@ int chetrs2_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, i int cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int chetrs2_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS2", &i__1); + xerbla_("CHETRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs_3.c b/src/map/lapack2flamec/f2c/c/chetrs_3.c index e35fda7ac..ce7612ac2 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs_3.c +++ b/src/map/lapack2flamec/f2c/c/chetrs_3.c @@ -187,7 +187,7 @@ int chetrs_3_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c int cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -243,7 +243,7 @@ int chetrs_3_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS_3", &i__1); + xerbla_("CHETRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs_aa.c b/src/map/lapack2flamec/f2c/c/chetrs_aa.c index a5f406781..c5878c03c 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/chetrs_aa.c @@ -145,7 +145,7 @@ int chetrs_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, int cswap_(integer *, complex *, integer *, complex *, integer *), cgtsv_(integer *, integer *, complex *, complex *, complex *, complex *, integer *, integer *), ctrsm_( char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -213,7 +213,7 @@ int chetrs_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS_AA", &i__1); + xerbla_("CHETRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/chetrs_aa_2stage.c index 1a8deda52..92d2713a3 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/chetrs_aa_2stage.c @@ -156,7 +156,7 @@ int chetrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -216,7 +216,7 @@ int chetrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS_AA_2STAGE", &i__1); + xerbla_("CHETRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chetrs_rook.c b/src/map/lapack2flamec/f2c/c/chetrs_rook.c index 9457dc3aa..edaf9e8d1 100644 --- a/src/map/lapack2flamec/f2c/c/chetrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/chetrs_rook.c @@ -157,7 +157,7 @@ int chetrs_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -212,7 +212,7 @@ int chetrs_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRS_ROOK", &i__1); + xerbla_("CHETRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chfrk.c b/src/map/lapack2flamec/f2c/c/chfrk.c index 594269cdd..2fbd11d5c 100644 --- a/src/map/lapack2flamec/f2c/c/chfrk.c +++ b/src/map/lapack2flamec/f2c/c/chfrk.c @@ -180,7 +180,7 @@ int chfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, real * logical lower; complex calpha; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -249,7 +249,7 @@ int chfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, real * if (info != 0) { i__1 = -info; - xerbla_("CHFRK ", &i__1); + xerbla_("CHFRK ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chgeqz.c b/src/map/lapack2flamec/f2c/c/chgeqz.c index 243e78482..8ba8e75f7 100644 --- a/src/map/lapack2flamec/f2c/c/chgeqz.c +++ b/src/map/lapack2flamec/f2c/c/chgeqz.c @@ -336,7 +336,7 @@ int chgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); complex eshift; logical ilschr; integer icompq, ilastm, ischur; @@ -494,7 +494,7 @@ int chgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ { i__1 = -(*info); AOCL_DTL_TRACE_LOG_EXIT - xerbla_("CHGEQZ", &i__1); + xerbla_("CHGEQZ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/chpcon.c b/src/map/lapack2flamec/f2c/c/chpcon.c index 2f85c1642..2c8a15491 100644 --- a/src/map/lapack2flamec/f2c/c/chpcon.c +++ b/src/map/lapack2flamec/f2c/c/chpcon.c @@ -127,7 +127,7 @@ int chpcon_(char *uplo, integer *n, complex *ap, integer * ipiv, real *anorm, re integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int chptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -174,7 +174,7 @@ int chpcon_(char *uplo, integer *n, complex *ap, integer * ipiv, real *anorm, re if (*info != 0) { i__1 = -(*info); - xerbla_("CHPCON", &i__1); + xerbla_("CHPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpev.c b/src/map/lapack2flamec/f2c/c/chpev.c index 529e645be..86b9774b0 100644 --- a/src/map/lapack2flamec/f2c/c/chpev.c +++ b/src/map/lapack2flamec/f2c/c/chpev.c @@ -163,7 +163,7 @@ int chpev_(char *jobz, char *uplo, integer *n, complex *ap, real *w, complex *z_ int csscal_(integer *, real *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau; extern /* Subroutine */ @@ -223,7 +223,7 @@ int chpev_(char *jobz, char *uplo, integer *n, complex *ap, real *w, complex *z_ if (*info != 0) { i__1 = -(*info); - xerbla_("CHPEV ", &i__1); + xerbla_("CHPEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpevd.c b/src/map/lapack2flamec/f2c/c/chpevd.c index 7a320a589..e3a23d6f7 100644 --- a/src/map/lapack2flamec/f2c/c/chpevd.c +++ b/src/map/lapack2flamec/f2c/c/chpevd.c @@ -232,7 +232,7 @@ int chpevd_(char *jobz, char *uplo, integer *n, complex *ap, real *w, complex *z int csscal_(integer *, real *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau; extern /* Subroutine */ @@ -340,7 +340,7 @@ int chpevd_(char *jobz, char *uplo, integer *n, complex *ap, real *w, complex *z if (*info != 0) { i__1 = -(*info); - xerbla_("CHPEVD", &i__1); + xerbla_("CHPEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpevx.c b/src/map/lapack2flamec/f2c/c/chpevx.c index 7b40f0352..a38a46390 100644 --- a/src/map/lapack2flamec/f2c/c/chpevx.c +++ b/src/map/lapack2flamec/f2c/c/chpevx.c @@ -269,7 +269,7 @@ int chpevx_(char *jobz, char *range, char *uplo, integer *n, complex *ap, real * int csscal_(integer *, real *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indiwk, indisp, indtau; extern /* Subroutine */ @@ -367,7 +367,7 @@ int chpevx_(char *jobz, char *range, char *uplo, integer *n, complex *ap, real * if (*info != 0) { i__1 = -(*info); - xerbla_("CHPEVX", &i__1); + xerbla_("CHPEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpgst.c b/src/map/lapack2flamec/f2c/c/chpgst.c index 32511c6ea..2742148d6 100644 --- a/src/map/lapack2flamec/f2c/c/chpgst.c +++ b/src/map/lapack2flamec/f2c/c/chpgst.c @@ -142,7 +142,7 @@ int chpgst_(integer *itype, char *uplo, integer *n, complex * ap, complex *bp, i int chpmv_(char *, integer *, complex *, complex *, complex *, integer *, complex *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), ctpmv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical upper; extern /* Subroutine */ - int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), csscal_( integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), csscal_( integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int chpgst_(integer *itype, char *uplo, integer *n, complex * ap, complex *bp, i if (*info != 0) { i__1 = -(*info); - xerbla_("CHPGST", &i__1); + xerbla_("CHPGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpgv.c b/src/map/lapack2flamec/f2c/c/chpgv.c index 082009eb8..f068f7f66 100644 --- a/src/map/lapack2flamec/f2c/c/chpgv.c +++ b/src/map/lapack2flamec/f2c/c/chpgv.c @@ -186,7 +186,7 @@ int chpgv_(integer *itype, char *jobz, char *uplo, integer * n, complex *ap, com int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), chpgst_( integer *, char *, integer *, complex *, complex *, integer *), cpptrf_(char *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chpgst_( integer *, char *, integer *, complex *, complex *, integer *), cpptrf_(char *, integer *, complex *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -240,7 +240,7 @@ int chpgv_(integer *itype, char *jobz, char *uplo, integer * n, complex *ap, com if (*info != 0) { i__1 = -(*info); - xerbla_("CHPGV ", &i__1); + xerbla_("CHPGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpgvd.c b/src/map/lapack2flamec/f2c/c/chpgvd.c index ea4e1f3be..f4c13ce2d 100644 --- a/src/map/lapack2flamec/f2c/c/chpgvd.c +++ b/src/map/lapack2flamec/f2c/c/chpgvd.c @@ -245,7 +245,7 @@ int chpgvd_(integer *itype, char *jobz, char *uplo, integer * n, complex *ap, co int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical wantz; extern /* Subroutine */ - int chpevd_(char *, char *, integer *, complex *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *, integer *), xerbla_(char *, integer *), chpgst_(integer *, char *, integer *, complex *, complex *, integer *), cpptrf_(char *, integer *, complex *, integer *); + int chpevd_(char *, char *, integer *, complex *, real *, complex *, integer *, complex *, integer *, real *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), chpgst_(integer *, char *, integer *, complex *, complex *, integer *), cpptrf_(char *, integer *, complex *, integer *); integer liwmin, lrwmin; logical lquery; /* -- LAPACK driver routine -- */ @@ -346,7 +346,7 @@ int chpgvd_(integer *itype, char *jobz, char *uplo, integer * n, complex *ap, co if (*info != 0) { i__1 = -(*info); - xerbla_("CHPGVD", &i__1); + xerbla_("CHPGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpgvx.c b/src/map/lapack2flamec/f2c/c/chpgvx.c index 65fd18a9a..82c441ce5 100644 --- a/src/map/lapack2flamec/f2c/c/chpgvx.c +++ b/src/map/lapack2flamec/f2c/c/chpgvx.c @@ -298,7 +298,7 @@ int chpgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, co int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical wantz, alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *), chpgst_( integer *, char *, integer *, complex *, complex *, integer *), chpevx_(char *, char *, char *, integer *, complex *, real *, real *, integer *, integer *, real *, integer *, real *, complex *, integer *, complex *, real *, integer *, integer *, integer *), cpptrf_(char *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chpgst_( integer *, char *, integer *, complex *, complex *, integer *), chpevx_(char *, char *, char *, integer *, complex *, real *, real *, integer *, integer *, real *, integer *, real *, complex *, integer *, complex *, real *, integer *, integer *, integer *), cpptrf_(char *, integer *, complex *, integer *); /* -- LAPACK driver routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -387,7 +387,7 @@ int chpgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, co if (*info != 0) { i__1 = -(*info); - xerbla_("CHPGVX", &i__1); + xerbla_("CHPGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chprfs.c b/src/map/lapack2flamec/f2c/c/chprfs.c index a00115b2d..13d909855 100644 --- a/src/map/lapack2flamec/f2c/c/chprfs.c +++ b/src/map/lapack2flamec/f2c/c/chprfs.c @@ -211,7 +211,7 @@ int chprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, i extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), chptrs_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chptrs_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); real lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -280,7 +280,7 @@ int chprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, i if (*info != 0) { i__1 = -(*info); - xerbla_("CHPRFS", &i__1); + xerbla_("CHPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpsv.c b/src/map/lapack2flamec/f2c/c/chpsv.c index f73eec6da..45db5895e 100644 --- a/src/map/lapack2flamec/f2c/c/chpsv.c +++ b/src/map/lapack2flamec/f2c/c/chpsv.c @@ -167,7 +167,7 @@ int chpsv_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, c /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), chptrf_( char *, integer *, complex *, integer *, integer *), chptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chptrf_( char *, integer *, complex *, integer *, integer *), chptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -212,7 +212,7 @@ int chpsv_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, c if (*info != 0) { i__1 = -(*info); - xerbla_("CHPSV ", &i__1); + xerbla_("CHPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chpsvx.c b/src/map/lapack2flamec/f2c/c/chpsvx.c index 76fa65a9d..e6740bf7e 100644 --- a/src/map/lapack2flamec/f2c/c/chpsvx.c +++ b/src/map/lapack2flamec/f2c/c/chpsvx.c @@ -287,7 +287,7 @@ int chpsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com extern real clanhp_(char *, char *, integer *, complex *, real *), slamch_(char *); logical nofact; extern /* Subroutine */ - int chpcon_(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), chprfs_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), chptrf_(char *, integer *, complex *, integer *, integer *), chptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int chpcon_(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), chprfs_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), chptrf_(char *, integer *, complex *, integer *, integer *), chptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -353,7 +353,7 @@ int chpsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com if (*info != 0) { i__1 = -(*info); - xerbla_("CHPSVX", &i__1); + xerbla_("CHPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chptrd.c b/src/map/lapack2flamec/f2c/c/chptrd.c index 6767a3634..b30e41959 100644 --- a/src/map/lapack2flamec/f2c/c/chptrd.c +++ b/src/map/lapack2flamec/f2c/c/chptrd.c @@ -169,7 +169,7 @@ int chptrd_(char *uplo, integer *n, complex *ap, real *d__, real *e, complex *ta int chpmv_(char *, integer *, complex *, complex *, complex *, integer *, complex *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -209,7 +209,7 @@ int chptrd_(char *uplo, integer *n, complex *ap, real *d__, real *e, complex *ta if (*info != 0) { i__1 = -(*info); - xerbla_("CHPTRD", &i__1); + xerbla_("CHPTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chptrf.c b/src/map/lapack2flamec/f2c/c/chptrf.c index b3cc6642e..4f89f911f 100644 --- a/src/map/lapack2flamec/f2c/c/chptrf.c +++ b/src/map/lapack2flamec/f2c/c/chptrf.c @@ -194,7 +194,7 @@ int chptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) real absakk; extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -226,6 +226,8 @@ int chptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) --ap; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -238,7 +240,7 @@ int chptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CHPTRF", &i__1); + xerbla_("CHPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chptri.c b/src/map/lapack2flamec/f2c/c/chptri.c index 6102565bd..93576f1af 100644 --- a/src/map/lapack2flamec/f2c/c/chptri.c +++ b/src/map/lapack2flamec/f2c/c/chptri.c @@ -139,7 +139,7 @@ int chptri_(char *uplo, integer *n, complex *ap, integer * ipiv, complex *work, integer kstep; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -180,7 +180,7 @@ int chptri_(char *uplo, integer *n, complex *ap, integer * ipiv, complex *work, if (*info != 0) { i__1 = -(*info); - xerbla_("CHPTRI", &i__1); + xerbla_("CHPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chptrs.c b/src/map/lapack2flamec/f2c/c/chptrs.c index 64a5ab975..881924653 100644 --- a/src/map/lapack2flamec/f2c/c/chptrs.c +++ b/src/map/lapack2flamec/f2c/c/chptrs.c @@ -138,7 +138,7 @@ int chptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -187,7 +187,7 @@ int chptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CHPTRS", &i__1); + xerbla_("CHPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chsein.c b/src/map/lapack2flamec/f2c/c/chsein.c index 43045dd7f..f94877669 100644 --- a/src/map/lapack2flamec/f2c/c/chsein.c +++ b/src/map/lapack2flamec/f2c/c/chsein.c @@ -275,7 +275,7 @@ int chsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, int claein_(logical *, logical *, integer *, complex *, integer *, complex *, complex *, complex *, integer *, real *, real *, real *, integer *); extern real slamch_(char *), clanhs_(char *, integer *, complex *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern logical sisnan_(real *); logical noinit; integer ldwork; @@ -378,7 +378,7 @@ int chsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, if (*info != 0) { i__1 = -(*info); - xerbla_("CHSEIN", &i__1); + xerbla_("CHSEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/chseqr.c b/src/map/lapack2flamec/f2c/c/chseqr.c index fb35eeeca..276918714 100644 --- a/src/map/lapack2flamec/f2c/c/chseqr.c +++ b/src/map/lapack2flamec/f2c/c/chseqr.c @@ -13,7 +13,6 @@ static complex c_b2 = ; static integer c__1 = 1; static integer c__12 = 12; -static integer c__2 = 2; static integer c__49 = 49; /* > \brief \b CHSEQR */ /* =========== DOCUMENTATION =========== */ @@ -303,8 +302,7 @@ int chseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, comp AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("chseqr inputs: job %c, compz %c, n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", ldh %" FLA_IS ", ldz %" FLA_IS "",*job, *compz, *n, *ilo, *ihi, *ldh, *ldz); /* System generated locals */ - address a__1[2]; - integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2]; + integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2; real r__1, r__2, r__3; complex q__1; char ch__1[2]; @@ -322,7 +320,7 @@ int chseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, comp complex workl[49]; logical wantt, wantz; extern /* Subroutine */ - int claqr0_(logical *, logical *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), clahqr_(logical *, logical *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int claqr0_(logical *, logical *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), clahqr_(logical *, logical *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical lquery; /* -- LAPACK computational routine -- */ @@ -412,7 +410,7 @@ int chseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, comp { /* ==== Quick return in case of invalid argument. ==== */ i__1 = -(*info); - xerbla_("CHSEQR", &i__1); + xerbla_("CHSEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_gbamv.c b/src/map/lapack2flamec/f2c/c/cla_gbamv.c index 9ae4cec54..8851e53a0 100644 --- a/src/map/lapack2flamec/f2c/c/cla_gbamv.c +++ b/src/map/lapack2flamec/f2c/c/cla_gbamv.c @@ -198,7 +198,7 @@ int cla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, real safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -266,7 +266,7 @@ int cla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, } if (info != 0) { - xerbla_("CLA_GBAMV ", &info); + xerbla_("CLA_GBAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_gbrcond_c.c b/src/map/lapack2flamec/f2c/c/cla_gbrcond_c.c index d289abef8..1d8b42baa 100644 --- a/src/map/lapack2flamec/f2c/c/cla_gbrcond_c.c +++ b/src/map/lapack2flamec/f2c/c/cla_gbrcond_c.c @@ -173,7 +173,7 @@ real cla_gbrcond_c_(char *trans, integer *n, integer *kl, integer *ku, complex * integer isave[3]; real anorm; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real ainvnm; logical notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -242,7 +242,7 @@ real cla_gbrcond_c_(char *trans, integer *n, integer *kl, integer *ku, complex * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_GBRCOND_C", &i__1); + xerbla_("CLA_GBRCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_gbrcond_x.c b/src/map/lapack2flamec/f2c/c/cla_gbrcond_x.c index 9b62b38c6..6be20e548 100644 --- a/src/map/lapack2flamec/f2c/c/cla_gbrcond_x.c +++ b/src/map/lapack2flamec/f2c/c/cla_gbrcond_x.c @@ -167,7 +167,7 @@ real cla_gbrcond_x_(char *trans, integer *n, integer *kl, integer *ku, complex * integer isave[3]; real anorm; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_(char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real ainvnm; logical notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -236,7 +236,7 @@ real cla_gbrcond_x_(char *trans, integer *n, integer *kl, integer *ku, complex * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_GBRCOND_X", &i__1); + xerbla_("CLA_GBRCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_geamv.c b/src/map/lapack2flamec/f2c/c/cla_geamv.c index e0f8c224f..17aa791f1 100644 --- a/src/map/lapack2flamec/f2c/c/cla_geamv.c +++ b/src/map/lapack2flamec/f2c/c/cla_geamv.c @@ -187,7 +187,7 @@ int cla_geamv_(integer *trans, integer *m, integer *n, real *alpha, complex *a, real safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -247,7 +247,7 @@ int cla_geamv_(integer *trans, integer *m, integer *n, real *alpha, complex *a, } if (info != 0) { - xerbla_("CLA_GEAMV ", &info); + xerbla_("CLA_GEAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_gercond_c.c b/src/map/lapack2flamec/f2c/c/cla_gercond_c.c index 07031f9bf..32440f2d2 100644 --- a/src/map/lapack2flamec/f2c/c/cla_gercond_c.c +++ b/src/map/lapack2flamec/f2c/c/cla_gercond_c.c @@ -155,7 +155,7 @@ real cla_gercond_c_(char *trans, integer *n, complex *a, integer *lda, complex * integer isave[3]; real anorm; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real ainvnm; logical notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -216,7 +216,7 @@ real cla_gercond_c_(char *trans, integer *n, complex *a, integer *lda, complex * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_GERCOND_C", &i__1); + xerbla_("CLA_GERCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_gercond_x.c b/src/map/lapack2flamec/f2c/c/cla_gercond_x.c index 4b8051faf..734c1b8f9 100644 --- a/src/map/lapack2flamec/f2c/c/cla_gercond_x.c +++ b/src/map/lapack2flamec/f2c/c/cla_gercond_x.c @@ -149,7 +149,7 @@ real cla_gercond_x_(char *trans, integer *n, complex *a, integer *lda, complex * integer isave[3]; real anorm; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real ainvnm; logical notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -210,7 +210,7 @@ real cla_gercond_x_(char *trans, integer *n, complex *a, integer *lda, complex * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_GERCOND_X", &i__1); + xerbla_("CLA_GERCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_heamv.c b/src/map/lapack2flamec/f2c/c/cla_heamv.c index a392418a5..141319683 100644 --- a/src/map/lapack2flamec/f2c/c/cla_heamv.c +++ b/src/map/lapack2flamec/f2c/c/cla_heamv.c @@ -187,7 +187,7 @@ int cla_heamv_(integer *uplo, integer *n, real *alpha, complex *a, integer *lda, real temp, safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -244,7 +244,7 @@ int cla_heamv_(integer *uplo, integer *n, real *alpha, complex *a, integer *lda, } if (info != 0) { - xerbla_("CHEMV ", &info); + xerbla_("CHEMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_hercond_c.c b/src/map/lapack2flamec/f2c/c/cla_hercond_c.c index ff3c4d792..1ffa1b680 100644 --- a/src/map/lapack2flamec/f2c/c/cla_hercond_c.c +++ b/src/map/lapack2flamec/f2c/c/cla_hercond_c.c @@ -153,7 +153,7 @@ real cla_hercond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int chetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -215,7 +215,7 @@ real cla_hercond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_HERCOND_C", &i__1); + xerbla_("CLA_HERCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_hercond_x.c b/src/map/lapack2flamec/f2c/c/cla_hercond_x.c index fd0023974..c39e226c0 100644 --- a/src/map/lapack2flamec/f2c/c/cla_hercond_x.c +++ b/src/map/lapack2flamec/f2c/c/cla_hercond_x.c @@ -147,7 +147,7 @@ real cla_hercond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int chetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -209,7 +209,7 @@ real cla_hercond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_HERCOND_X", &i__1); + xerbla_("CLA_HERCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_herfsx_extended.c b/src/map/lapack2flamec/f2c/c/cla_herfsx_extended.c index e65424470..bf842c393 100644 --- a/src/map/lapack2flamec/f2c/c/cla_herfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/cla_herfsx_extended.c @@ -446,7 +446,7 @@ int cla_herfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * real normx, normy; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), chetrs_( char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); real normdx, hugeval; extern integer ilauplo_(char *); integer x_state__, z_state__; @@ -534,7 +534,7 @@ int cla_herfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_HERFSX_EXTENDED", &i__1); + xerbla_("CLA_HERFSX_EXTENDED", &i__1, (ftnlen)19); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_porcond_c.c b/src/map/lapack2flamec/f2c/c/cla_porcond_c.c index abbb8d0e1..d60a7b8a9 100644 --- a/src/map/lapack2flamec/f2c/c/cla_porcond_c.c +++ b/src/map/lapack2flamec/f2c/c/cla_porcond_c.c @@ -145,7 +145,7 @@ real cla_porcond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int cpotrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -206,7 +206,7 @@ real cla_porcond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_PORCOND_C", &i__1); + xerbla_("CLA_PORCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_porcond_x.c b/src/map/lapack2flamec/f2c/c/cla_porcond_x.c index 1f50d5842..9749a6cab 100644 --- a/src/map/lapack2flamec/f2c/c/cla_porcond_x.c +++ b/src/map/lapack2flamec/f2c/c/cla_porcond_x.c @@ -139,7 +139,7 @@ real cla_porcond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int cpotrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -200,7 +200,7 @@ real cla_porcond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_PORCOND_X", &i__1); + xerbla_("CLA_PORCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_syamv.c b/src/map/lapack2flamec/f2c/c/cla_syamv.c index 79009efd4..8ee88b081 100644 --- a/src/map/lapack2flamec/f2c/c/cla_syamv.c +++ b/src/map/lapack2flamec/f2c/c/cla_syamv.c @@ -188,7 +188,7 @@ int cla_syamv_(integer *uplo, integer *n, real *alpha, complex *a, integer *lda, real temp, safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -245,7 +245,7 @@ int cla_syamv_(integer *uplo, integer *n, real *alpha, complex *a, integer *lda, } if (info != 0) { - xerbla_("CLA_SYAMV", &info); + xerbla_("CLA_SYAMV", &info, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cla_syrcond_c.c b/src/map/lapack2flamec/f2c/c/cla_syrcond_c.c index d2737e1ba..c5542bc24 100644 --- a/src/map/lapack2flamec/f2c/c/cla_syrcond_c.c +++ b/src/map/lapack2flamec/f2c/c/cla_syrcond_c.c @@ -153,7 +153,7 @@ real cla_syrcond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csytrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -215,7 +215,7 @@ real cla_syrcond_c_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_SYRCOND_C", &i__1); + xerbla_("CLA_SYRCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_syrcond_x.c b/src/map/lapack2flamec/f2c/c/cla_syrcond_x.c index 100b8d645..ca151d5f7 100644 --- a/src/map/lapack2flamec/f2c/c/cla_syrcond_x.c +++ b/src/map/lapack2flamec/f2c/c/cla_syrcond_x.c @@ -147,7 +147,7 @@ real cla_syrcond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a real anorm; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csytrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -209,7 +209,7 @@ real cla_syrcond_x_(char *uplo, integer *n, complex *a, integer *lda, complex *a if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_SYRCOND_X", &i__1); + xerbla_("CLA_SYRCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/cla_syrfsx_extended.c b/src/map/lapack2flamec/f2c/c/cla_syrfsx_extended.c index 8679aef0a..c8e67d136 100644 --- a/src/map/lapack2flamec/f2c/c/cla_syrfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/cla_syrfsx_extended.c @@ -447,7 +447,7 @@ int cla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * real normx, normy; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real normdx; extern /* Subroutine */ int csytrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -538,7 +538,7 @@ int cla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CLA_SYRFSX_EXTENDED", &i__1); + xerbla_("CLA_SYRFSX_EXTENDED", &i__1, (ftnlen)19); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clabrd.c b/src/map/lapack2flamec/f2c/c/clabrd.c index 524eca5bd..d7f8a9f8c 100644 --- a/src/map/lapack2flamec/f2c/c/clabrd.c +++ b/src/map/lapack2flamec/f2c/c/clabrd.c @@ -288,16 +288,17 @@ int fla_clabrd(integer *m, integer *n, integer *nb, complex *a, integer *lda, re y_offset = 1 + y_dim1; y -= y_offset; -#ifdef FLA_OPENMP_MULTITHREADING - /* Get optimum thread number for CLABRD*/ - FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); -#endif - /* Function Body */ if (*m <= 0 || *n <= 0) { return 0; } + +#ifdef FLA_OPENMP_MULTITHREADING + /* Get optimum thread number for CLABRD*/ + FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); +#endif + if (*m >= *n) { /* Reduce to upper bidiagonal form */ diff --git a/src/map/lapack2flamec/f2c/c/clacgv.c b/src/map/lapack2flamec/f2c/c/clacgv.c index a8016a8f5..b6ab813c1 100644 --- a/src/map/lapack2flamec/f2c/c/clacgv.c +++ b/src/map/lapack2flamec/f2c/c/clacgv.c @@ -73,7 +73,7 @@ int clacgv_(integer *n, complex *x, integer *incx) AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - integer i__1, i__2; + integer i__1; complex q__1; /* Local variables */ integer i__, ioff; diff --git a/src/map/lapack2flamec/f2c/c/claed0.c b/src/map/lapack2flamec/f2c/c/claed0.c index d15f400a3..513dab7f8 100644 --- a/src/map/lapack2flamec/f2c/c/claed0.c +++ b/src/map/lapack2flamec/f2c/c/claed0.c @@ -170,7 +170,7 @@ int claed0_(integer *qsiz, integer *n, real *d__, real *e, complex *q, integer * int clacrm_(integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, real *); integer igivcl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer igivnm, submat, curprb, subpbs, igivpt, curlvl, matsiz, iprmpt, smlsiz; extern /* Subroutine */ @@ -233,7 +233,7 @@ int claed0_(integer *qsiz, integer *n, real *d__, real *e, complex *q, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CLAED0", &i__1); + xerbla_("CLAED0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/claed7.c b/src/map/lapack2flamec/f2c/c/claed7.c index 4bc48dd51..25a5845f5 100644 --- a/src/map/lapack2flamec/f2c/c/claed7.c +++ b/src/map/lapack2flamec/f2c/c/claed7.c @@ -258,7 +258,7 @@ int claed7_(integer *n, integer *cutpnt, integer *qsiz, integer *tlvls, integer int claed8_(integer *, integer *, integer *, complex *, integer *, real *, real *, integer *, real *, real *, complex *, integer *, real *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *), slaed9_( integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, real *, real *, integer *, integer *), slaeda_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, integer *); integer idlmda; extern /* Subroutine */ - int clacrm_(integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, real *), xerbla_(char *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); + int clacrm_(integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); integer coltyp; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -317,7 +317,7 @@ int claed7_(integer *n, integer *cutpnt, integer *qsiz, integer *tlvls, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CLAED7", &i__1); + xerbla_("CLAED7", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/claed8.c b/src/map/lapack2flamec/f2c/c/claed8.c index b899231fb..941797147 100644 --- a/src/map/lapack2flamec/f2c/c/claed8.c +++ b/src/map/lapack2flamec/f2c/c/claed8.c @@ -243,7 +243,7 @@ int claed8_(integer *k, integer *n, integer *qsiz, complex * q, integer *ldq, re int sscal_(integer *, real *, real *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *), scopy_(integer *, real *, integer *, real *, integer *); extern real slapy2_(real *, real *), slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer *, integer *, integer *); @@ -287,6 +287,7 @@ int claed8_(integer *k, integer *n, integer *qsiz, complex * q, integer *ldq, re givnum -= 3; /* Function Body */ *info = 0; + jlam = 0; if (*n < 0) { *info = -2; @@ -310,7 +311,7 @@ int claed8_(integer *k, integer *n, integer *qsiz, complex * q, integer *ldq, re if (*info != 0) { i__1 = -(*info); - xerbla_("CLAED8", &i__1); + xerbla_("CLAED8", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/claein.c b/src/map/lapack2flamec/f2c/c/claein.c index 7527b01cb..7b1b821c2 100644 --- a/src/map/lapack2flamec/f2c/c/claein.c +++ b/src/map/lapack2flamec/f2c/c/claein.c @@ -169,7 +169,7 @@ int claein_(logical *rightv, logical *noinit, integer *n, complex *h__, integer extern real scnrm2_(integer *, complex *, integer *); extern integer icamax_(integer *, complex *, integer *); extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *), clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *); extern real scasum_(integer *, complex *, integer *); diff --git a/src/map/lapack2flamec/f2c/c/clahef.c b/src/map/lapack2flamec/f2c/c/clahef.c index 41f78101d..e89f48486 100644 --- a/src/map/lapack2flamec/f2c/c/clahef.c +++ b/src/map/lapack2flamec/f2c/c/clahef.c @@ -241,6 +241,7 @@ int clahef_(char *uplo, integer *n, integer *nb, integer *kb, complex *a, intege w -= w_offset; /* Function Body */ *info = 0; + imax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; if (lsame_(uplo, "U")) diff --git a/src/map/lapack2flamec/f2c/c/clahef_rk.c b/src/map/lapack2flamec/f2c/c/clahef_rk.c index 187d44798..e91b4bbef 100644 --- a/src/map/lapack2flamec/f2c/c/clahef_rk.c +++ b/src/map/lapack2flamec/f2c/c/clahef_rk.c @@ -338,6 +338,8 @@ int clahef_rk_(char *uplo, integer *n, integer *nb, integer *kb, complex *a, int w -= w_offset; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/clahef_rook.c b/src/map/lapack2flamec/f2c/c/clahef_rook.c index 8a622252c..a865fff5c 100644 --- a/src/map/lapack2flamec/f2c/c/clahef_rook.c +++ b/src/map/lapack2flamec/f2c/c/clahef_rook.c @@ -256,6 +256,8 @@ int clahef_rook_(char *uplo, integer *n, integer *nb, integer *kb, complex *a, i w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; + imax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/clahqr.c b/src/map/lapack2flamec/f2c/c/clahqr.c index e2339de9e..f7c34554c 100644 --- a/src/map/lapack2flamec/f2c/c/clahqr.c +++ b/src/map/lapack2flamec/f2c/c/clahqr.c @@ -275,6 +275,7 @@ int clahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i z__ -= z_offset; /* Function Body */ *info = 0; + i2 = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/clahr2.c b/src/map/lapack2flamec/f2c/c/clahr2.c index e231027eb..d154613c3 100644 --- a/src/map/lapack2flamec/f2c/c/clahr2.c +++ b/src/map/lapack2flamec/f2c/c/clahr2.c @@ -232,6 +232,8 @@ int clahr2_(integer *n, integer *k, integer *nb, complex *a, integer *lda, compl y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei.r = 0.f; + ei.i = 0.f; if (*n <= 1) { AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); diff --git a/src/map/lapack2flamec/f2c/c/clals0.c b/src/map/lapack2flamec/f2c/c/clals0.c index 7f8518630..15b633606 100644 --- a/src/map/lapack2flamec/f2c/c/clals0.c +++ b/src/map/lapack2flamec/f2c/c/clals0.c @@ -291,7 +291,7 @@ int clals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n int ccopy_(integer *, complex *, integer *, complex *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *), csscal_(integer *, real *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real dsigjp; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -340,6 +340,7 @@ int clals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n /* Function Body */ *info = 0; n = *nl + *nr + 1; + difrj = 0.f; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -387,7 +388,7 @@ int clals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n if (*info != 0) { i__1 = -(*info); - xerbla_("CLALS0", &i__1); + xerbla_("CLALS0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clalsa.c b/src/map/lapack2flamec/f2c/c/clalsa.c index 16b34bccb..2f275bb91 100644 --- a/src/map/lapack2flamec/f2c/c/clalsa.c +++ b/src/map/lapack2flamec/f2c/c/clalsa.c @@ -279,7 +279,7 @@ int clalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, complex int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); integer ndimr; extern /* Subroutine */ - int ccopy_(integer *, complex *, integer *, complex *, integer *), clals0_(integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer * ); + int ccopy_(integer *, complex *, integer *, complex *, integer *), clals0_(integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer * ); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -376,7 +376,7 @@ int clalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CLALSA", &i__1); + xerbla_("CLALSA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clalsd.c b/src/map/lapack2flamec/f2c/c/clalsd.c index 6fb12f0db..54c2f5630 100644 --- a/src/map/lapack2flamec/f2c/c/clalsd.c +++ b/src/map/lapack2flamec/f2c/c/clalsd.c @@ -226,7 +226,7 @@ int clalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, real *d__, r int clalsa_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_( char *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer * ); + int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer * ); extern integer isamax_(integer *, real *, integer *); integer givcol; extern /* Subroutine */ @@ -284,7 +284,7 @@ int clalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, real *d__, r if (*info != 0) { i__1 = -(*info); - xerbla_("CLALSD", &i__1); + xerbla_("CLALSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clamswlq.c b/src/map/lapack2flamec/f2c/c/clamswlq.c index 67d8687b0..91b598032 100644 --- a/src/map/lapack2flamec/f2c/c/clamswlq.c +++ b/src/map/lapack2flamec/f2c/c/clamswlq.c @@ -211,7 +211,7 @@ int clamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int cgemlqt_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpmlqt_(char *, char *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -300,7 +300,7 @@ int clamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CLAMSWLQ", &i__1); + xerbla_("CLAMSWLQ", &i__1, (ftnlen)8); work[1].r = (real) lw; work[1].i = 0.f; // , expr subst AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); diff --git a/src/map/lapack2flamec/f2c/c/clamtsqr.c b/src/map/lapack2flamec/f2c/c/clamtsqr.c index 51ced1bf6..c7a669021 100644 --- a/src/map/lapack2flamec/f2c/c/clamtsqr.c +++ b/src/map/lapack2flamec/f2c/c/clamtsqr.c @@ -214,7 +214,7 @@ int clamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int cgemqrt_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpmqrt_(char *, char *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); @@ -311,7 +311,7 @@ int clamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CLAMTSQR", &i__1); + xerbla_("CLAMTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clangb.c b/src/map/lapack2flamec/f2c/c/clangb.c index a362de883..2c38db549 100644 --- a/src/map/lapack2flamec/f2c/c/clangb.c +++ b/src/map/lapack2flamec/f2c/c/clangb.c @@ -161,6 +161,7 @@ real clangb_(char *norm, integer *n, integer *kl, integer *ku, complex *ab, inte ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clange.c b/src/map/lapack2flamec/f2c/c/clange.c index 60f5d28b9..f4df196a8 100644 --- a/src/map/lapack2flamec/f2c/c/clange.c +++ b/src/map/lapack2flamec/f2c/c/clange.c @@ -152,6 +152,7 @@ real clange_(char *norm, integer *m, integer *n, complex *a, integer *lda, real a -= a_offset; --work; /* Function Body */ + value = 0.f; if (fla_min(*m,*n) == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clangt.c b/src/map/lapack2flamec/f2c/c/clangt.c index f452f2bde..18725d823 100644 --- a/src/map/lapack2flamec/f2c/c/clangt.c +++ b/src/map/lapack2flamec/f2c/c/clangt.c @@ -143,6 +143,7 @@ real clangt_(char *norm, integer *n, complex *dl, complex *d__, complex *du) --d__; --dl; /* Function Body */ + anorm = 0.f; if (*n <= 0) { anorm = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanhb.c b/src/map/lapack2flamec/f2c/c/clanhb.c index 7fe06593d..3f1100ce5 100644 --- a/src/map/lapack2flamec/f2c/c/clanhb.c +++ b/src/map/lapack2flamec/f2c/c/clanhb.c @@ -169,6 +169,7 @@ real clanhb_(char *norm, char *uplo, integer *n, integer *k, complex *ab, intege ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanhe.c b/src/map/lapack2flamec/f2c/c/clanhe.c index 30c4a3711..f40d61c7a 100644 --- a/src/map/lapack2flamec/f2c/c/clanhe.c +++ b/src/map/lapack2flamec/f2c/c/clanhe.c @@ -161,6 +161,7 @@ real clanhe_(char *norm, char *uplo, integer *n, complex *a, integer *lda, real a -= a_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanhf.c b/src/map/lapack2flamec/f2c/c/clanhf.c index 1a89fb90d..22a475276 100644 --- a/src/map/lapack2flamec/f2c/c/clanhf.c +++ b/src/map/lapack2flamec/f2c/c/clanhf.c @@ -286,6 +286,7 @@ real clanhf_(char *norm, char *transr, char *uplo, integer *n, complex *a, real /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + value = 0.f; if (*n == 0) { ret_val = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanhp.c b/src/map/lapack2flamec/f2c/c/clanhp.c index d2dda3512..49db109f2 100644 --- a/src/map/lapack2flamec/f2c/c/clanhp.c +++ b/src/map/lapack2flamec/f2c/c/clanhp.c @@ -153,6 +153,7 @@ real clanhp_(char *norm, char *uplo, integer *n, complex *ap, real *work) --work; --ap; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanhs.c b/src/map/lapack2flamec/f2c/c/clanhs.c index 2d2ec513f..0a5f68291 100644 --- a/src/map/lapack2flamec/f2c/c/clanhs.c +++ b/src/map/lapack2flamec/f2c/c/clanhs.c @@ -147,6 +147,7 @@ real clanhs_(char *norm, integer *n, complex *a, integer *lda, real *work) a -= a_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clanht.c b/src/map/lapack2flamec/f2c/c/clanht.c index 75aecaec0..7235ce4ef 100644 --- a/src/map/lapack2flamec/f2c/c/clanht.c +++ b/src/map/lapack2flamec/f2c/c/clanht.c @@ -129,6 +129,7 @@ real clanht_(char *norm, integer *n, real *d__, complex *e) --e; --d__; /* Function Body */ + anorm = 0.f; if (*n <= 0) { anorm = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clansb.c b/src/map/lapack2flamec/f2c/c/clansb.c index 835890181..0f9dcb84d 100644 --- a/src/map/lapack2flamec/f2c/c/clansb.c +++ b/src/map/lapack2flamec/f2c/c/clansb.c @@ -167,6 +167,7 @@ real clansb_(char *norm, char *uplo, integer *n, integer *k, complex *ab, intege ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clansp.c b/src/map/lapack2flamec/f2c/c/clansp.c index 9f8db5850..233f0bbc6 100644 --- a/src/map/lapack2flamec/f2c/c/clansp.c +++ b/src/map/lapack2flamec/f2c/c/clansp.c @@ -151,6 +151,7 @@ real clansp_(char *norm, char *uplo, integer *n, complex *ap, real *work) --work; --ap; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clansy.c b/src/map/lapack2flamec/f2c/c/clansy.c index d6b0e71e3..5ea0ad034 100644 --- a/src/map/lapack2flamec/f2c/c/clansy.c +++ b/src/map/lapack2flamec/f2c/c/clansy.c @@ -160,6 +160,7 @@ real clansy_(char *norm, char *uplo, integer *n, complex *a, integer *lda, real a -= a_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clantb.c b/src/map/lapack2flamec/f2c/c/clantb.c index f5e72c416..f61142249 100644 --- a/src/map/lapack2flamec/f2c/c/clantb.c +++ b/src/map/lapack2flamec/f2c/c/clantb.c @@ -179,6 +179,7 @@ real clantb_(char *norm, char *uplo, char *diag, integer *n, integer *k, complex ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clantp.c b/src/map/lapack2flamec/f2c/c/clantp.c index c9c7fb34f..f94cdcb3c 100644 --- a/src/map/lapack2flamec/f2c/c/clantp.c +++ b/src/map/lapack2flamec/f2c/c/clantp.c @@ -162,6 +162,7 @@ real clantp_(char *norm, char *uplo, char *diag, integer *n, complex *ap, real * --work; --ap; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/clantr.c b/src/map/lapack2flamec/f2c/c/clantr.c index e016b9c17..fc71f3dc2 100644 --- a/src/map/lapack2flamec/f2c/c/clantr.c +++ b/src/map/lapack2flamec/f2c/c/clantr.c @@ -179,6 +179,7 @@ real clantr_(char *norm, char *uplo, char *diag, integer *m, integer *n, complex a -= a_offset; --work; /* Function Body */ + value = 0.f; if (fla_min(*m,*n) == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/claqr0.c b/src/map/lapack2flamec/f2c/c/claqr0.c index 18189b5af..376f9239a 100644 --- a/src/map/lapack2flamec/f2c/c/claqr0.c +++ b/src/map/lapack2flamec/f2c/c/claqr0.c @@ -324,6 +324,7 @@ int claqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/claqr4.c b/src/map/lapack2flamec/f2c/c/claqr4.c index 11161bf07..6689c7667 100644 --- a/src/map/lapack2flamec/f2c/c/claqr4.c +++ b/src/map/lapack2flamec/f2c/c/claqr4.c @@ -331,6 +331,7 @@ int claqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/claqr5.c b/src/map/lapack2flamec/f2c/c/claqr5.c index 276f4b984..42f96b83b 100644 --- a/src/map/lapack2flamec/f2c/c/claqr5.c +++ b/src/map/lapack2flamec/f2c/c/claqr5.c @@ -268,10 +268,8 @@ int claqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer /* System generated locals */ integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10; - complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; + complex q__1, q__2, q__3, q__4, q__5, q__6, q__7; /* Local variables */ - extern /* Subroutine */ - int f90_cycle_(void); integer j, k, m, i2, k1, i4; real h11, h12, h21, h22; integer m22, ns, nu; @@ -342,6 +340,8 @@ int claqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer wh_offset = 1 + wh_dim1; wh -= wh_offset; /* Function Body */ + q__5.r = 0.f; + q__5.i = 0.f; if (*nshfts < 2) { AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); @@ -1092,11 +1092,11 @@ int claqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer { /* Computing MAX */ r__5 = (r__1 = u1r, f2c_abs(r__1)) + (r__2 = u1i, f2c_abs(r__2)); - r__6 = (r__3 = u2r, f2c_abs(r__3)) + ( r__4 = u2i, abs(r__4)); // , expr subst + r__6 = (r__3 = u2r, f2c_abs(r__3)) + ( r__4 = u2i, f2c_abs(r__4)); // , expr subst h12 = fla_max(r__5,r__6); /* Computing MIN */ r__5 = (r__1 = u1r, f2c_abs(r__1)) + (r__2 = u1i, f2c_abs(r__2)); - r__6 = (r__3 = u2r, f2c_abs(r__3)) + ( r__4 = u2i, abs(r__4)); // , expr subst + r__6 = (r__3 = u2r, f2c_abs(r__3)) + ( r__4 = u2i, f2c_abs(r__4)); // , expr subst h21 = fla_min(r__5,r__6); i__4 = k + k * h_dim1; i__5 = k + 1 + (k + 1) * h_dim1; diff --git a/src/map/lapack2flamec/f2c/c/claqz0.c b/src/map/lapack2flamec/f2c/c/claqz0.c index c339abf2a..024aebeac 100644 --- a/src/map/lapack2flamec/f2c/c/claqz0.c +++ b/src/map/lapack2flamec/f2c/c/claqz0.c @@ -302,8 +302,6 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *); /* Local variables */ integer aed_info__; - extern /* Subroutine */ - int f90_cycle_(void); integer shiftpos, lworkreq, k; real c1; integer k2; @@ -335,7 +333,7 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ @@ -345,8 +343,6 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in integer iwantq, iwants, istart; real smlnum; integer istopm, iwantz, istart2; - extern /* Subroutine */ - int f90_exit_(void); logical ilschur; integer nshifts, istartm; /* Arguments */ @@ -372,6 +368,8 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in --work; --rwork; /* Function Body */ + eshift.r = 0.f; + eshift.i = 0.f; if (lsame_(wants, "E")) { ilschur = FALSE_; @@ -469,7 +467,7 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in if (*info != 0) { i__1 = -(*info); - xerbla_("CLAQZ0", &i__1); + xerbla_("CLAQZ0", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -540,7 +538,7 @@ int claqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in } if (*info != 0) { - xerbla_("CLAQZ0", info); + xerbla_("CLAQZ0", info, (ftnlen)6); return 0; } /* Initialize Q and Z */ diff --git a/src/map/lapack2flamec/f2c/c/claqz2.c b/src/map/lapack2flamec/f2c/c/claqz2.c index ab46841a6..b1eaaef9a 100644 --- a/src/map/lapack2flamec/f2c/c/claqz2.c +++ b/src/map/lapack2flamec/f2c/c/claqz2.c @@ -268,7 +268,7 @@ int claqz2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int ctgexc_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *), clartg_( complex *, complex *, real *, complex *, complex *); @@ -350,7 +350,7 @@ int claqz2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("CLAQZ2", &i__1); + xerbla_("CLAQZ2", &i__1, (ftnlen)6); return 0; } /* Get machine constants */ diff --git a/src/map/lapack2flamec/f2c/c/claqz3.c b/src/map/lapack2flamec/f2c/c/claqz3.c index 08dcad049..ec242abd1 100644 --- a/src/map/lapack2flamec/f2c/c/claqz3.c +++ b/src/map/lapack2flamec/f2c/c/claqz3.c @@ -228,7 +228,7 @@ int claqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clartg_(complex *, complex *, real *, complex *, complex *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); @@ -280,7 +280,7 @@ int claqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("CLAQZ3", &i__1); + xerbla_("CLAQZ3", &i__1, (ftnlen)6); return 0; } /* Executable statements */ diff --git a/src/map/lapack2flamec/f2c/c/clarfg.c b/src/map/lapack2flamec/f2c/c/clarfg.c index 0104a4ca9..278a6d844 100644 --- a/src/map/lapack2flamec/f2c/c/clarfg.c +++ b/src/map/lapack2flamec/f2c/c/clarfg.c @@ -124,7 +124,7 @@ int clarfg_(integer *n, complex *alpha, complex *x, integer * incx, complex *tau real alphi, alphr, xnorm; extern real scnrm2_(integer *, complex *, integer *), slapy3_(real *, real *, real *); extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *); diff --git a/src/map/lapack2flamec/f2c/c/clarfgp.c b/src/map/lapack2flamec/f2c/c/clarfgp.c index ac9925dc7..4cf16b818 100644 --- a/src/map/lapack2flamec/f2c/c/clarfgp.c +++ b/src/map/lapack2flamec/f2c/c/clarfgp.c @@ -124,7 +124,7 @@ int clarfgp_(integer *n, complex *alpha, complex *x, integer *incx, complex *tau real alphi, alphr, xnorm; extern real scnrm2_(integer *, complex *, integer *), slapy2_(real *, real *), slapy3_(real *, real *, real *); extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *); diff --git a/src/map/lapack2flamec/f2c/c/clarrv.c b/src/map/lapack2flamec/f2c/c/clarrv.c index 8124d2c69..099b631dd 100644 --- a/src/map/lapack2flamec/f2c/c/clarrv.c +++ b/src/map/lapack2flamec/f2c/c/clarrv.c @@ -307,7 +307,6 @@ int clarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i real ztz; integer iend, jblk; real lgap; - integer done; real rgap, left; integer wend, iter; real bstw; @@ -473,8 +472,6 @@ int clarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i /* entries is contained in the interval IBEGIN:IEND. */ /* Remark that if k eigenpairs are desired, then the eigenvectors */ /* are stored in k contiguous columns of Z. */ - /* DONE is the number of eigenvectors already computed */ - done = 0; ibegin = 1; wbegin = 1; i__1 = iblock[*m]; @@ -533,7 +530,6 @@ int clarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i /* This is for a 1x1 block */ if (ibegin == iend) { - ++done; i__2 = ibegin + wbegin * z_dim1; z__[i__2].r = 1.f; z__[i__2].i = 0.f; // , expr subst @@ -920,7 +916,6 @@ int clarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i i__4 = windex + 1; windpl = fla_min(i__4,*m); lambda = work[windex]; - ++done; /* Check if eigenvector computation is to be skipped */ if (windex < *dol || windex > *dou) { diff --git a/src/map/lapack2flamec/f2c/c/clarzb.c b/src/map/lapack2flamec/f2c/c/clarzb.c index 48648f471..229d7cdb5 100644 --- a/src/map/lapack2flamec/f2c/c/clarzb.c +++ b/src/map/lapack2flamec/f2c/c/clarzb.c @@ -198,7 +198,7 @@ int clarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int ccopy_(integer *, complex *, integer *, complex *, integer *), ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int ccopy_(integer *, complex *, integer *, complex *, integer *), ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); char transt[1]; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -251,7 +251,7 @@ int clarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in if (info != 0) { i__1 = -info; - xerbla_("CLARZB", &i__1); + xerbla_("CLARZB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clarzt.c b/src/map/lapack2flamec/f2c/c/clarzt.c index 47630e9ed..24a6a22e8 100644 --- a/src/map/lapack2flamec/f2c/c/clarzt.c +++ b/src/map/lapack2flamec/f2c/c/clarzt.c @@ -202,7 +202,7 @@ int clarzt_(char *direct, char *storev, integer *n, integer * k, complex *v, int int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -243,7 +243,7 @@ int clarzt_(char *direct, char *storev, integer *n, integer * k, complex *v, int if (info != 0) { i__1 = -info; - xerbla_("CLARZT", &i__1); + xerbla_("CLARZT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clascl.c b/src/map/lapack2flamec/f2c/c/clascl.c index 96026e027..e56a9393b 100644 --- a/src/map/lapack2flamec/f2c/c/clascl.c +++ b/src/map/lapack2flamec/f2c/c/clascl.c @@ -149,7 +149,7 @@ int clascl_(char *type__, integer *kl, integer *ku, real * cfrom, real *cto, int extern real slamch_(char *); real cfromc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern logical sisnan_(real *); real smlnum; @@ -260,7 +260,7 @@ int clascl_(char *type__, integer *kl, integer *ku, real * cfrom, real *cto, int if (*info != 0) { i__1 = -(*info); - xerbla_("CLASCL", &i__1); + xerbla_("CLASCL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clasr.c b/src/map/lapack2flamec/f2c/c/clasr.c index fb8c54c09..460899689 100644 --- a/src/map/lapack2flamec/f2c/c/clasr.c +++ b/src/map/lapack2flamec/f2c/c/clasr.c @@ -207,7 +207,7 @@ int clasr_(char *side, char *pivot, char *direct, integer *m, integer *n, real * extern logical lsame_(char *, char *); real ctemp, stemp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -263,7 +263,7 @@ int clasr_(char *side, char *pivot, char *direct, integer *m, integer *n, real * } if (info != 0) { - xerbla_("CLASR ", &info); + xerbla_("CLASR ", &info, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/classq.c b/src/map/lapack2flamec/f2c/c/classq.c index 16c0fe621..7acd48a9f 100644 --- a/src/map/lapack2flamec/f2c/c/classq.c +++ b/src/map/lapack2flamec/f2c/c/classq.c @@ -130,7 +130,7 @@ int classq_(integer *n, complex *x, integer *incx, real *scl, real *sumsq) { integer i__; real ax; integer ix; - real sbi, abig, amed, sbig, tbig, asml, ymin, ssml, tsml, ymax; + real abig, amed, sbig, tbig, asml, ymin, ssml, tsml, ymax; logical notbig; /* ...Translated by Pacific-Sierra Research vf90 Personal 3.4N3 09:17:33 8/30/21 */ /* ...Switches: */ diff --git a/src/map/lapack2flamec/f2c/c/claswlq.c b/src/map/lapack2flamec/f2c/c/claswlq.c index 7dcac08f7..0d01449c8 100644 --- a/src/map/lapack2flamec/f2c/c/claswlq.c +++ b/src/map/lapack2flamec/f2c/c/claswlq.c @@ -174,7 +174,7 @@ int claswlq_(integer *m, integer *n, integer *mb, integer * nb, complex *a, inte /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), cgelqt_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctplqt_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgelqt_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctplqt_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -243,7 +243,7 @@ int claswlq_(integer *m, integer *n, integer *mb, integer * nb, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CLASWLQ", &i__1); + xerbla_("CLASWLQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clasyf_rk.c b/src/map/lapack2flamec/f2c/c/clasyf_rk.c index e5671a373..b25c1116b 100644 --- a/src/map/lapack2flamec/f2c/c/clasyf_rk.c +++ b/src/map/lapack2flamec/f2c/c/clasyf_rk.c @@ -333,6 +333,7 @@ int clasyf_rk_(char *uplo, integer *n, integer *nb, integer *kb, complex *a, int w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/clasyf_rook.c b/src/map/lapack2flamec/f2c/c/clasyf_rook.c index 4baff80bb..acb1f672e 100644 --- a/src/map/lapack2flamec/f2c/c/clasyf_rook.c +++ b/src/map/lapack2flamec/f2c/c/clasyf_rook.c @@ -251,6 +251,7 @@ int clasyf_rook_(char *uplo, integer *n, integer *nb, integer *kb, complex *a, i w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/clatbs.c b/src/map/lapack2flamec/f2c/c/clatbs.c index a02f39c72..b50f7330d 100644 --- a/src/map/lapack2flamec/f2c/c/clatbs.c +++ b/src/map/lapack2flamec/f2c/c/clatbs.c @@ -281,10 +281,10 @@ int clatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte logical upper; extern integer icamax_(integer *, complex *, integer *); extern /* Complex */ - VOID cladiv_f2c_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); extern real scasum_(integer *, complex *, integer *); @@ -358,7 +358,7 @@ int clatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CLATBS", &i__1); + xerbla_("CLATBS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clatps.c b/src/map/lapack2flamec/f2c/c/clatps.c index ba4fc64e6..e6fb9be42 100644 --- a/src/map/lapack2flamec/f2c/c/clatps.c +++ b/src/map/lapack2flamec/f2c/c/clatps.c @@ -271,10 +271,10 @@ int clatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, comp int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), slabad_( real *, real *); extern integer icamax_(integer *, complex *, integer *); extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); extern real scasum_(integer *, complex *, integer *); @@ -339,7 +339,7 @@ int clatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CLATPS", &i__1); + xerbla_("CLATPS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clatrs.c b/src/map/lapack2flamec/f2c/c/clatrs.c index 734a1f88b..56623ac33 100644 --- a/src/map/lapack2flamec/f2c/c/clatrs.c +++ b/src/map/lapack2flamec/f2c/c/clatrs.c @@ -277,10 +277,10 @@ int clatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, comp int ctrsv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *); extern integer icamax_(integer *, complex *, integer *); extern /* Complex */ - VOID cladiv_f2c_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); extern real scasum_(integer *, complex *, integer *); @@ -350,7 +350,7 @@ int clatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CLATRS", &i__1); + xerbla_("CLATRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clatrs3.c b/src/map/lapack2flamec/f2c/c/clatrs3.c index ce58c29fb..bd5ca9ac0 100644 --- a/src/map/lapack2flamec/f2c/c/clatrs3.c +++ b/src/map/lapack2flamec/f2c/c/clatrs3.c @@ -251,7 +251,7 @@ int clatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int int csscal_(integer *, real *, complex *, integer *); real scamin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -369,7 +369,7 @@ int clatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int if (*info != 0) { i__1 = -(*info); - xerbla_("CLATRS3", &i__1); + xerbla_("CLATRS3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/clatsqr.c b/src/map/lapack2flamec/f2c/c/clatsqr.c index 52c7c0ef2..2056f922a 100644 --- a/src/map/lapack2flamec/f2c/c/clatsqr.c +++ b/src/map/lapack2flamec/f2c/c/clatsqr.c @@ -176,7 +176,7 @@ int clatsqr_(integer *m, integer *n, integer *mb, integer * nb, complex *a, inte /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), cgeqrt_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpqrt_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgeqrt_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpqrt_(integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -243,7 +243,7 @@ int clatsqr_(integer *m, integer *n, integer *mb, integer * nb, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CLATSQR", &i__1); + xerbla_("CLATSQR", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp.c b/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp.c index f92b95663..cb46fa7f7 100644 --- a/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp.c +++ b/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp.c @@ -164,7 +164,7 @@ int claunhr_col_getrfnp_(integer *m, integer *n, complex *a, integer *lda, compl int claunhr_col_getrfnp2_(integer *, integer *, complex *, integer *, complex *, integer *), cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); integer iinfo; extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -209,7 +209,7 @@ int claunhr_col_getrfnp_(integer *m, integer *n, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CLAUNHR_COL_GETRFNP", &i__1); + xerbla_("CLAUNHR_COL_GETRFNP", &i__1, (ftnlen)19); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp2.c b/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp2.c index b6aeef7a7..f08221d14 100644 --- a/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp2.c +++ b/src/map/lapack2flamec/f2c/c/claunhr_col_getrfnp2.c @@ -193,7 +193,7 @@ int claunhr_col_getrfnp2_(integer *m, integer *n, complex * a, integer *lda, com int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -241,7 +241,7 @@ int claunhr_col_getrfnp2_(integer *m, integer *n, complex * a, integer *lda, com if (*info != 0) { i__1 = -(*info); - xerbla_("CLAUNHR_COL_GETRFNP2", &i__1); + xerbla_("CLAUNHR_COL_GETRFNP2", &i__1, (ftnlen)20); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbcon.c b/src/map/lapack2flamec/f2c/c/cpbcon.c index 3fcad85b8..4de74930e 100644 --- a/src/map/lapack2flamec/f2c/c/cpbcon.c +++ b/src/map/lapack2flamec/f2c/c/cpbcon.c @@ -154,7 +154,7 @@ int cpbcon_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, rea int clatbs_(char *, char *, char *, char *, integer *, integer *, complex *, integer *, complex *, real *, real *, integer *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csrscl_(integer *, real *, complex *, integer *); @@ -219,7 +219,7 @@ int cpbcon_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, rea if (*info != 0) { i__1 = -(*info); - xerbla_("CPBCON", &i__1); + xerbla_("CPBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbequ.c b/src/map/lapack2flamec/f2c/c/cpbequ.c index de4dcee3b..5d969be62 100644 --- a/src/map/lapack2flamec/f2c/c/cpbequ.c +++ b/src/map/lapack2flamec/f2c/c/cpbequ.c @@ -141,7 +141,7 @@ int cpbequ_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, rea extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -190,7 +190,7 @@ int cpbequ_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, rea if (*info != 0) { i__1 = -(*info); - xerbla_("CPBEQU", &i__1); + xerbla_("CPBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbrfs.c b/src/map/lapack2flamec/f2c/c/cpbrfs.c index 22a8482f7..e38734b4f 100644 --- a/src/map/lapack2flamec/f2c/c/cpbrfs.c +++ b/src/map/lapack2flamec/f2c/c/cpbrfs.c @@ -220,7 +220,7 @@ int cpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, in extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), cpbtrs_( char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbtrs_( char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); real lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -304,7 +304,7 @@ int cpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("CPBRFS", &i__1); + xerbla_("CPBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbstf.c b/src/map/lapack2flamec/f2c/c/cpbstf.c index 2edea6977..25b082bd1 100644 --- a/src/map/lapack2flamec/f2c/c/cpbstf.c +++ b/src/map/lapack2flamec/f2c/c/cpbstf.c @@ -173,7 +173,7 @@ int cpbstf_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -221,7 +221,7 @@ int cpbstf_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPBSTF", &i__1); + xerbla_("CPBSTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbsv.c b/src/map/lapack2flamec/f2c/c/cpbsv.c index eb3c2ee06..e88bdfac5 100644 --- a/src/map/lapack2flamec/f2c/c/cpbsv.c +++ b/src/map/lapack2flamec/f2c/c/cpbsv.c @@ -169,7 +169,7 @@ int cpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, int /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), cpbtrf_( char *, integer *, integer *, complex *, integer *, integer *), cpbtrs_(char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbtrf_( char *, integer *, integer *, complex *, integer *, integer *), cpbtrs_(char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -223,7 +223,7 @@ int cpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPBSV ", &i__1); + xerbla_("CPBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbsvx.c b/src/map/lapack2flamec/f2c/c/cpbsvx.c index f4f2ac7e9..3ef0a5fff 100644 --- a/src/map/lapack2flamec/f2c/c/cpbsvx.c +++ b/src/map/lapack2flamec/f2c/c/cpbsvx.c @@ -363,7 +363,7 @@ int cpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, comp extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cpbequ_(char *, integer *, integer *, complex *, integer *, real *, real *, real *, integer *), cpbrfs_( char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpbequ_(char *, integer *, integer *, complex *, integer *, real *, real *, real *, integer *), cpbrfs_( char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); real bignum; extern /* Subroutine */ int cpbtrf_(char *, integer *, integer *, complex *, integer *, integer *); @@ -414,6 +414,8 @@ int cpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, comp nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); upper = lsame_(uplo, "U"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -507,7 +509,7 @@ int cpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CPBSVX", &i__1); + xerbla_("CPBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbtf2.c b/src/map/lapack2flamec/f2c/c/cpbtf2.c index 5d36f4b93..b52d988d4 100644 --- a/src/map/lapack2flamec/f2c/c/cpbtf2.c +++ b/src/map/lapack2flamec/f2c/c/cpbtf2.c @@ -158,7 +158,7 @@ int cpbtf2_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -206,7 +206,7 @@ int cpbtf2_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPBTF2", &i__1); + xerbla_("CPBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbtrf.c b/src/map/lapack2flamec/f2c/c/cpbtrf.c index a697bf931..1363036e9 100644 --- a/src/map/lapack2flamec/f2c/c/cpbtrf.c +++ b/src/map/lapack2flamec/f2c/c/cpbtrf.c @@ -162,7 +162,7 @@ int cpbtrf_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cherk_(char *, char *, integer *, integer *, real *, complex *, integer *, real *, complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), cpbtf2_(char *, integer *, integer *, complex *, integer *, integer *), cpotf2_(char *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), cpbtf2_(char *, integer *, integer *, complex *, integer *, integer *), cpotf2_(char *, integer *, complex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -212,7 +212,7 @@ int cpbtrf_(char *uplo, integer *n, integer *kd, complex *ab, integer *ldab, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPBTRF", &i__1); + xerbla_("CPBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpbtrs.c b/src/map/lapack2flamec/f2c/c/cpbtrs.c index 8592ade65..549af7bd3 100644 --- a/src/map/lapack2flamec/f2c/c/cpbtrs.c +++ b/src/map/lapack2flamec/f2c/c/cpbtrs.c @@ -132,7 +132,7 @@ int cpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, in int ctbsv_(char *, char *, char *, integer *, integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -189,7 +189,7 @@ int cpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, complex *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("CPBTRS", &i__1); + xerbla_("CPBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpftrf.c b/src/map/lapack2flamec/f2c/c/cpftrf.c index 9b8464ee5..d1ac298ac 100644 --- a/src/map/lapack2flamec/f2c/c/cpftrf.c +++ b/src/map/lapack2flamec/f2c/c/cpftrf.c @@ -232,7 +232,7 @@ int cpftrf_(char *transr, char *uplo, integer *n, complex *a, integer *info) extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int cpotrf_(char *, integer *, complex *, integer *, integer *); @@ -274,7 +274,7 @@ int cpftrf_(char *transr, char *uplo, integer *n, complex *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CPFTRF", &i__1); + xerbla_("CPFTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpftri.c b/src/map/lapack2flamec/f2c/c/cpftri.c index 06df7544d..4bd7a050a 100644 --- a/src/map/lapack2flamec/f2c/c/cpftri.c +++ b/src/map/lapack2flamec/f2c/c/cpftri.c @@ -234,7 +234,7 @@ int cpftri_(char *transr, char *uplo, integer *n, complex *a, integer *info) int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int clauum_(char *, integer *, complex *, integer *, integer *), ctftri_(char *, char *, char *, integer *, complex *, integer *); @@ -276,7 +276,7 @@ int cpftri_(char *transr, char *uplo, integer *n, complex *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CPFTRI", &i__1); + xerbla_("CPFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpftrs.c b/src/map/lapack2flamec/f2c/c/cpftrs.c index 0dacf947f..5930c6350 100644 --- a/src/map/lapack2flamec/f2c/c/cpftrs.c +++ b/src/map/lapack2flamec/f2c/c/cpftrs.c @@ -236,7 +236,7 @@ int cpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, complex *a, co int ctfsm_(char *, char *, char *, char *, char *, integer *, integer *, complex *, complex *, complex *, integer *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -289,7 +289,7 @@ int cpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, complex *a, co if (*info != 0) { i__1 = -(*info); - xerbla_("CPFTRS", &i__1); + xerbla_("CPFTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpocon.c b/src/map/lapack2flamec/f2c/c/cpocon.c index a9eb156e3..4949edb08 100644 --- a/src/map/lapack2flamec/f2c/c/cpocon.c +++ b/src/map/lapack2flamec/f2c/c/cpocon.c @@ -139,7 +139,7 @@ int cpocon_(char *uplo, integer *n, complex *a, integer *lda, real *anorm, real extern real slamch_(char *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *), csrscl_(integer *, real *, complex *, integer *); @@ -200,7 +200,7 @@ int cpocon_(char *uplo, integer *n, complex *a, integer *lda, real *anorm, real if (*info != 0) { i__1 = -(*info); - xerbla_("CPOCON", &i__1); + xerbla_("CPOCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpoequ.c b/src/map/lapack2flamec/f2c/c/cpoequ.c index 3f424b308..7d13de6de 100644 --- a/src/map/lapack2flamec/f2c/c/cpoequ.c +++ b/src/map/lapack2flamec/f2c/c/cpoequ.c @@ -120,7 +120,7 @@ int cpoequ_(integer *n, complex *a, integer *lda, real *s, real *scond, real *am integer i__; real smin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int cpoequ_(integer *n, complex *a, integer *lda, real *s, real *scond, real *am if (*info != 0) { i__1 = -(*info); - xerbla_("CPOEQU", &i__1); + xerbla_("CPOEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpoequb.c b/src/map/lapack2flamec/f2c/c/cpoequb.c index 9cccbebf7..ea9d2fd3a 100644 --- a/src/map/lapack2flamec/f2c/c/cpoequb.c +++ b/src/map/lapack2flamec/f2c/c/cpoequb.c @@ -121,7 +121,7 @@ int cpoequb_(integer *n, complex *a, integer *lda, real *s, real *scond, real *a real tmp, base, smin; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -162,7 +162,7 @@ int cpoequb_(integer *n, complex *a, integer *lda, real *s, real *scond, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("CPOEQUB", &i__1); + xerbla_("CPOEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cporfs.c b/src/map/lapack2flamec/f2c/c/cporfs.c index f6f0f5fb0..f86d30e3b 100644 --- a/src/map/lapack2flamec/f2c/c/cporfs.c +++ b/src/map/lapack2flamec/f2c/c/cporfs.c @@ -213,7 +213,7 @@ int cporfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), cpotrs_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpotrs_( char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); real lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -293,7 +293,7 @@ int cporfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CPORFS", &i__1); + xerbla_("CPORFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cporfsx.c b/src/map/lapack2flamec/f2c/c/cporfsx.c index f13c5bd08..132fc6ccc 100644 --- a/src/map/lapack2flamec/f2c/c/cporfsx.c +++ b/src/map/lapack2flamec/f2c/c/cporfsx.c @@ -419,7 +419,7 @@ int cporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in logical rcequ; extern real cla_porcond_c_(char *, integer *, complex *, integer *, complex *, integer *, real *, logical *, integer *, complex *, real *), cla_porcond_x_(char *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, real *), clanhe_(char *, char *, integer *, complex *, integer *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), cpocon_( char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpocon_( char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); extern integer ilaprec_(char *); integer ithresh, n_norms__; real rthresh; @@ -566,7 +566,7 @@ int cporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CPORFSX", &i__1); + xerbla_("CPORFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cposv.c b/src/map/lapack2flamec/f2c/c/cposv.c index f6efe8471..b718bff85 100644 --- a/src/map/lapack2flamec/f2c/c/cposv.c +++ b/src/map/lapack2flamec/f2c/c/cposv.c @@ -134,7 +134,7 @@ int cposv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, comp /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), cpotrf_( char *, integer *, complex *, integer *, integer *), cpotrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpotrf_( char *, integer *, complex *, integer *, integer *), cpotrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -184,7 +184,7 @@ int cposv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CPOSV ", &i__1); + xerbla_("CPOSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cposvx.c b/src/map/lapack2flamec/f2c/c/cposvx.c index c7c5a2cee..7a33a658d 100644 --- a/src/map/lapack2flamec/f2c/c/cposvx.c +++ b/src/map/lapack2flamec/f2c/c/cposvx.c @@ -322,7 +322,7 @@ int cposvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int cpocon_(char *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *); @@ -372,6 +372,8 @@ int cposvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -461,7 +463,7 @@ int cposvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CPOSVX", &i__1); + xerbla_("CPOSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cposvxx.c b/src/map/lapack2flamec/f2c/c/cposvxx.c index 2d1767e48..cbc009508 100644 --- a/src/map/lapack2flamec/f2c/c/cposvxx.c +++ b/src/map/lapack2flamec/f2c/c/cposvxx.c @@ -517,7 +517,7 @@ int cposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -666,7 +666,7 @@ int cposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPOSVXX", &i__1); + xerbla_("CPOSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpotrf2.c b/src/map/lapack2flamec/f2c/c/cpotrf2.c index 77873872c..46ae0bfdf 100644 --- a/src/map/lapack2flamec/f2c/c/cpotrf2.c +++ b/src/map/lapack2flamec/f2c/c/cpotrf2.c @@ -130,7 +130,7 @@ int cpotrf2_(char *uplo, integer *n, complex *a, integer * lda, integer *info) int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -175,7 +175,7 @@ int cpotrf2_(char *uplo, integer *n, complex *a, integer * lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CPOTRF2", &i__1); + xerbla_("CPOTRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpotrs.c b/src/map/lapack2flamec/f2c/c/cpotrs.c index 7c98509d7..fe69b213c 100644 --- a/src/map/lapack2flamec/f2c/c/cpotrs.c +++ b/src/map/lapack2flamec/f2c/c/cpotrs.c @@ -123,7 +123,7 @@ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -178,7 +178,7 @@ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CPOTRS", &i__1); + xerbla_("CPOTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cppcon.c b/src/map/lapack2flamec/f2c/c/cppcon.c index d8c0306b7..7bcc8e214 100644 --- a/src/map/lapack2flamec/f2c/c/cppcon.c +++ b/src/map/lapack2flamec/f2c/c/cppcon.c @@ -138,7 +138,7 @@ int cppcon_(char *uplo, integer *n, complex *ap, real *anorm, real *rcond, compl extern real slamch_(char *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *), clatps_( char *, char *, char *, char *, integer *, complex *, complex *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), clatps_( char *, char *, char *, char *, integer *, complex *, complex *, real *, real *, integer *); real ainvnm; extern /* Subroutine */ int csrscl_(integer *, real *, complex *, integer *); @@ -193,7 +193,7 @@ int cppcon_(char *uplo, integer *n, complex *ap, real *anorm, real *rcond, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CPPCON", &i__1); + xerbla_("CPPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cppequ.c b/src/map/lapack2flamec/f2c/c/cppequ.c index 1ffcac42b..481e16385 100644 --- a/src/map/lapack2flamec/f2c/c/cppequ.c +++ b/src/map/lapack2flamec/f2c/c/cppequ.c @@ -128,7 +128,7 @@ int cppequ_(char *uplo, integer *n, complex *ap, real *s, real *scond, real *ama extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int cppequ_(char *uplo, integer *n, complex *ap, real *s, real *scond, real *ama if (*info != 0) { i__1 = -(*info); - xerbla_("CPPEQU", &i__1); + xerbla_("CPPEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpprfs.c b/src/map/lapack2flamec/f2c/c/cpprfs.c index 0af594a39..41971904f 100644 --- a/src/map/lapack2flamec/f2c/c/cpprfs.c +++ b/src/map/lapack2flamec/f2c/c/cpprfs.c @@ -202,7 +202,7 @@ int cpprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, c extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), cpptrs_( char *, integer *, integer *, complex *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpptrs_( char *, integer *, integer *, complex *, complex *, integer *, integer *); real lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -270,7 +270,7 @@ int cpprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, c if (*info != 0) { i__1 = -(*info); - xerbla_("CPPRFS", &i__1); + xerbla_("CPPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cppsv.c b/src/map/lapack2flamec/f2c/c/cppsv.c index d3508bc71..09d712ced 100644 --- a/src/map/lapack2flamec/f2c/c/cppsv.c +++ b/src/map/lapack2flamec/f2c/c/cppsv.c @@ -149,7 +149,7 @@ int cppsv_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *b, inte /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), cpptrf_( char *, integer *, complex *, integer *), cpptrs_(char *, integer *, integer *, complex *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpptrf_( char *, integer *, complex *, integer *), cpptrs_(char *, integer *, integer *, complex *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -193,7 +193,7 @@ int cppsv_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *b, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CPPSV ", &i__1); + xerbla_("CPPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cppsvx.c b/src/map/lapack2flamec/f2c/c/cppsvx.c index 3c60c9a51..3b20e8f30 100644 --- a/src/map/lapack2flamec/f2c/c/cppsvx.c +++ b/src/map/lapack2flamec/f2c/c/cppsvx.c @@ -332,7 +332,7 @@ int cppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com int claqhp_(char *, integer *, complex *, real *, real *, real *, char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int cppcon_(char *, integer *, complex *, real *, real *, complex *, real *, integer *); @@ -380,6 +380,8 @@ int cppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -461,7 +463,7 @@ int cppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com if (*info != 0) { i__1 = -(*info); - xerbla_("CPPSVX", &i__1); + xerbla_("CPPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpptrf.c b/src/map/lapack2flamec/f2c/c/cpptrf.c index 148584faf..188abbd1e 100644 --- a/src/map/lapack2flamec/f2c/c/cpptrf.c +++ b/src/map/lapack2flamec/f2c/c/cpptrf.c @@ -138,7 +138,7 @@ int cpptrf_(char *uplo, integer *n, complex *ap, integer * info) extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), csscal_( integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), csscal_( integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int cpptrf_(char *uplo, integer *n, complex *ap, integer * info) if (*info != 0) { i__1 = -(*info); - xerbla_("CPPTRF", &i__1); + xerbla_("CPPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpptri.c b/src/map/lapack2flamec/f2c/c/cpptri.c index 9c81e62fa..bbb8c9f44 100644 --- a/src/map/lapack2flamec/f2c/c/cpptri.c +++ b/src/map/lapack2flamec/f2c/c/cpptri.c @@ -113,7 +113,7 @@ int cpptri_(char *uplo, integer *n, complex *ap, integer * info) int ctpmv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical upper; extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *), ctptri_(char *, char *, integer *, complex *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctptri_(char *, char *, integer *, complex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -151,7 +151,7 @@ int cpptri_(char *uplo, integer *n, complex *ap, integer * info) if (*info != 0) { i__1 = -(*info); - xerbla_("CPPTRI", &i__1); + xerbla_("CPPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpptrs.c b/src/map/lapack2flamec/f2c/c/cpptrs.c index 9f7f016dd..32ffc4146 100644 --- a/src/map/lapack2flamec/f2c/c/cpptrs.c +++ b/src/map/lapack2flamec/f2c/c/cpptrs.c @@ -117,7 +117,7 @@ int cpptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *b, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), xerbla_( char *, integer *); + int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -164,7 +164,7 @@ int cpptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *b, int if (*info != 0) { i__1 = -(*info); - xerbla_("CPPTRS", &i__1); + xerbla_("CPPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpstf2.c b/src/map/lapack2flamec/f2c/c/cpstf2.c index ec4ce2d05..9021c51a9 100644 --- a/src/map/lapack2flamec/f2c/c/cpstf2.c +++ b/src/map/lapack2flamec/f2c/c/cpstf2.c @@ -172,7 +172,7 @@ int cpstf2_(char *uplo, integer *n, complex *a, integer *lda, integer *piv, inte int clacgv_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer smaxloc_(real *, integer *); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -220,7 +220,7 @@ int cpstf2_(char *uplo, integer *n, complex *a, integer *lda, integer *piv, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CPSTF2", &i__1); + xerbla_("CPSTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpstrf.c b/src/map/lapack2flamec/f2c/c/cpstrf.c index 9f75066d0..7129c7701 100644 --- a/src/map/lapack2flamec/f2c/c/cpstrf.c +++ b/src/map/lapack2flamec/f2c/c/cpstrf.c @@ -177,7 +177,7 @@ int cpstrf_(char *uplo, integer *n, complex *a, integer *lda, integer *piv, inte int cpstf2_(char *, integer *, complex *, integer *, integer *, integer *, real *, real *, integer *), clacgv_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *), smaxloc_(real *, integer *); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -225,7 +225,7 @@ int cpstrf_(char *uplo, integer *n, complex *a, integer *lda, integer *piv, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CPSTRF", &i__1); + xerbla_("CPSTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cptcon.c b/src/map/lapack2flamec/f2c/c/cptcon.c index c879f6cb6..ea1794d14 100644 --- a/src/map/lapack2flamec/f2c/c/cptcon.c +++ b/src/map/lapack2flamec/f2c/c/cptcon.c @@ -127,7 +127,7 @@ int cptcon_(integer *n, real *d__, complex *e, real *anorm, real *rcond, real *r /* Local variables */ integer i__, ix; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -168,7 +168,7 @@ int cptcon_(integer *n, real *d__, complex *e, real *anorm, real *rcond, real *r if (*info != 0) { i__1 = -(*info); - xerbla_("CPTCON", &i__1); + xerbla_("CPTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpteqr.c b/src/map/lapack2flamec/f2c/c/cpteqr.c index 3eca73076..604acef6a 100644 --- a/src/map/lapack2flamec/f2c/c/cpteqr.c +++ b/src/map/lapack2flamec/f2c/c/cpteqr.c @@ -171,7 +171,7 @@ int cpteqr_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * integer nru; extern logical lsame_(char *, char *); extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, real *, integer *); integer icompz; extern /* Subroutine */ int spttrf_(integer *, real *, real *, integer *); @@ -238,7 +238,7 @@ int cpteqr_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CPTEQR", &i__1); + xerbla_("CPTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cptrfs.c b/src/map/lapack2flamec/f2c/c/cptrfs.c index b83edaf21..3f0f723b3 100644 --- a/src/map/lapack2flamec/f2c/c/cptrfs.c +++ b/src/map/lapack2flamec/f2c/c/cptrfs.c @@ -209,7 +209,7 @@ int cptrfs_(char *uplo, integer *n, integer *nrhs, real *d__, complex *e, real * extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real lstres; extern /* Subroutine */ @@ -280,7 +280,7 @@ int cptrfs_(char *uplo, integer *n, integer *nrhs, real *d__, complex *e, real * if (*info != 0) { i__1 = -(*info); - xerbla_("CPTRFS", &i__1); + xerbla_("CPTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cptsv.c b/src/map/lapack2flamec/f2c/c/cptsv.c index 9b636e086..8fc5ce48d 100644 --- a/src/map/lapack2flamec/f2c/c/cptsv.c +++ b/src/map/lapack2flamec/f2c/c/cptsv.c @@ -117,7 +117,7 @@ int cptsv_(integer *n, integer *nrhs, real *d__, complex *e, complex *b, integer integer b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), cpttrf_( integer *, real *, complex *, integer *), cpttrs_(char *, integer *, integer *, real *, complex *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cpttrf_( integer *, real *, complex *, integer *), cpttrs_(char *, integer *, integer *, real *, complex *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,7 +156,7 @@ int cptsv_(integer *n, integer *nrhs, real *d__, complex *e, complex *b, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CPTSV ", &i__1); + xerbla_("CPTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cptsvx.c b/src/map/lapack2flamec/f2c/c/cptsvx.c index f092cd76f..596862984 100644 --- a/src/map/lapack2flamec/f2c/c/cptsvx.c +++ b/src/map/lapack2flamec/f2c/c/cptsvx.c @@ -242,7 +242,7 @@ int cptsvx_(char *fact, integer *n, integer *nrhs, real *d__, complex *e, real * extern real slamch_(char *), clanht_(char *, integer *, real *, complex *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), cptcon_(integer *, real *, complex *, real *, real *, real *, integer *), cptrfs_(char *, integer *, integer *, real *, complex *, real *, complex *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer * ), cpttrf_(integer *, real *, complex *, integer *), cpttrs_(char *, integer *, integer *, real *, complex *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), cptcon_(integer *, real *, complex *, real *, real *, real *, integer *), cptrfs_(char *, integer *, integer *, real *, complex *, real *, complex *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer * ), cpttrf_(integer *, real *, complex *, integer *), cpttrs_(char *, integer *, integer *, real *, complex *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -305,7 +305,7 @@ int cptsvx_(char *fact, integer *n, integer *nrhs, real *d__, complex *e, real * if (*info != 0) { i__1 = -(*info); - xerbla_("CPTSVX", &i__1); + xerbla_("CPTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpttrf.c b/src/map/lapack2flamec/f2c/c/cpttrf.c index 1dbef9423..06e1f2877 100644 --- a/src/map/lapack2flamec/f2c/c/cpttrf.c +++ b/src/map/lapack2flamec/f2c/c/cpttrf.c @@ -101,7 +101,7 @@ int cpttrf_(integer *n, real *d__, complex *e, integer *info) integer i__, i4; real eii, eir; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -130,7 +130,7 @@ int cpttrf_(integer *n, real *d__, complex *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("CPTTRF", &i__1); + xerbla_("CPTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cpttrs.c b/src/map/lapack2flamec/f2c/c/cpttrs.c index 1a3ec181a..0580bcecb 100644 --- a/src/map/lapack2flamec/f2c/c/cpttrs.c +++ b/src/map/lapack2flamec/f2c/c/cpttrs.c @@ -128,7 +128,7 @@ int cpttrs_(char *uplo, integer *n, integer *nrhs, real *d__, complex *e, comple integer j, jb, nb, iuplo; logical upper; extern /* Subroutine */ - int cptts2_(integer *, integer *, integer *, real *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cptts2_(integer *, integer *, integer *, real *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -177,7 +177,7 @@ int cpttrs_(char *uplo, integer *n, integer *nrhs, real *d__, complex *e, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CPTTRS", &i__1); + xerbla_("CPTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/crot.c b/src/map/lapack2flamec/f2c/c/crot.c index f2be2e1ca..4f15b9161 100644 --- a/src/map/lapack2flamec/f2c/c/crot.c +++ b/src/map/lapack2flamec/f2c/c/crot.c @@ -102,8 +102,8 @@ int crot_(integer *n, complex *cx, integer *incx, complex * cy, integer *incy, r AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - integer i__1, i__2, i__3, i__4; - complex q__1, q__2, q__3, q__4; + integer i__1; + complex q__1, q__2, q__3; /* Local variables */ integer i__, ix, iy; complex stemp; diff --git a/src/map/lapack2flamec/f2c/c/cspcon.c b/src/map/lapack2flamec/f2c/c/cspcon.c index 81feb01a4..a8e42e9d5 100644 --- a/src/map/lapack2flamec/f2c/c/cspcon.c +++ b/src/map/lapack2flamec/f2c/c/cspcon.c @@ -127,7 +127,7 @@ int cspcon_(char *uplo, integer *n, complex *ap, integer * ipiv, real *anorm, re integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -174,7 +174,7 @@ int cspcon_(char *uplo, integer *n, complex *ap, integer * ipiv, real *anorm, re if (*info != 0) { i__1 = -(*info); - xerbla_("CSPCON", &i__1); + xerbla_("CSPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cspmv.c b/src/map/lapack2flamec/f2c/c/cspmv.c index 05ed3e477..dc1ec8400 100644 --- a/src/map/lapack2flamec/f2c/c/cspmv.c +++ b/src/map/lapack2flamec/f2c/c/cspmv.c @@ -157,7 +157,7 @@ int cspmv_(char *uplo, integer *n, complex *alpha, complex * ap, complex *x, int complex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -201,7 +201,7 @@ int cspmv_(char *uplo, integer *n, complex *alpha, complex * ap, complex *x, int } if (info != 0) { - xerbla_("CSPMV ", &info); + xerbla_("CSPMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cspr.c b/src/map/lapack2flamec/f2c/c/cspr.c index 7670cd8de..81058894e 100644 --- a/src/map/lapack2flamec/f2c/c/cspr.c +++ b/src/map/lapack2flamec/f2c/c/cspr.c @@ -138,7 +138,7 @@ int cspr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com complex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,6 +163,7 @@ int cspr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com --x; /* Function Body */ info = 0; + kx = 0; if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { info = 1; @@ -177,7 +178,7 @@ int cspr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com } if (info != 0) { - xerbla_("CSPR ", &info); + xerbla_("CSPR ", &info, (ftnlen)5); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csprfs.c b/src/map/lapack2flamec/f2c/c/csprfs.c index f1d742248..41a0ce529 100644 --- a/src/map/lapack2flamec/f2c/c/csprfs.c +++ b/src/map/lapack2flamec/f2c/c/csprfs.c @@ -213,7 +213,7 @@ int csprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, i extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int csptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -284,7 +284,7 @@ int csprfs_(char *uplo, integer *n, integer *nrhs, complex * ap, complex *afp, i if (*info != 0) { i__1 = -(*info); - xerbla_("CSPRFS", &i__1); + xerbla_("CSPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cspsv.c b/src/map/lapack2flamec/f2c/c/cspsv.c index 2d81a59cc..aad140995 100644 --- a/src/map/lapack2flamec/f2c/c/cspsv.c +++ b/src/map/lapack2flamec/f2c/c/cspsv.c @@ -167,7 +167,7 @@ int cspsv_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, c /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), csptrf_( char *, integer *, complex *, integer *, integer *), csptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), csptrf_( char *, integer *, complex *, integer *, integer *), csptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -212,7 +212,7 @@ int cspsv_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, c if (*info != 0) { i__1 = -(*info); - xerbla_("CSPSV ", &i__1); + xerbla_("CSPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cspsvx.c b/src/map/lapack2flamec/f2c/c/cspsvx.c index ad1cb52e2..3bfaa3c6d 100644 --- a/src/map/lapack2flamec/f2c/c/cspsvx.c +++ b/src/map/lapack2flamec/f2c/c/cspsvx.c @@ -287,7 +287,7 @@ int cspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real clansp_(char *, char *, integer *, complex *, real *); extern /* Subroutine */ int cspcon_(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), csprfs_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, real *, integer *), csptrf_(char *, integer *, complex *, integer *, integer *), csptrs_(char *, integer *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -356,7 +356,7 @@ int cspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *ap, com if (*info != 0) { i__1 = -(*info); - xerbla_("CSPSVX", &i__1); + xerbla_("CSPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csptrf.c b/src/map/lapack2flamec/f2c/c/csptrf.c index f321a6eec..7980a0491 100644 --- a/src/map/lapack2flamec/f2c/c/csptrf.c +++ b/src/map/lapack2flamec/f2c/c/csptrf.c @@ -193,7 +193,7 @@ int csptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) real absakk; extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -226,6 +226,7 @@ int csptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -237,7 +238,7 @@ int csptrf_(char *uplo, integer *n, complex *ap, integer * ipiv, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CSPTRF", &i__1); + xerbla_("CSPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csptri.c b/src/map/lapack2flamec/f2c/c/csptri.c index 560682b20..1273b13f0 100644 --- a/src/map/lapack2flamec/f2c/c/csptri.c +++ b/src/map/lapack2flamec/f2c/c/csptri.c @@ -145,7 +145,7 @@ int csptri_(char *uplo, integer *n, complex *ap, integer * ipiv, complex *work, int cspmv_(char *, integer *, complex *, complex *, complex *, integer *, complex *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -186,7 +186,7 @@ int csptri_(char *uplo, integer *n, complex *ap, integer * ipiv, complex *work, if (*info != 0) { i__1 = -(*info); - xerbla_("CSPTRI", &i__1); + xerbla_("CSPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csptrs.c b/src/map/lapack2flamec/f2c/c/csptrs.c index fa7fb4bed..35d83016a 100644 --- a/src/map/lapack2flamec/f2c/c/csptrs.c +++ b/src/map/lapack2flamec/f2c/c/csptrs.c @@ -139,7 +139,7 @@ int csptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -188,7 +188,7 @@ int csptrs_(char *uplo, integer *n, integer *nrhs, complex * ap, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CSPTRS", &i__1); + xerbla_("CSPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cstedc.c b/src/map/lapack2flamec/f2c/c/cstedc.c index 30d273016..2699d1932 100644 --- a/src/map/lapack2flamec/f2c/c/cstedc.c +++ b/src/map/lapack2flamec/f2c/c/cstedc.c @@ -241,7 +241,7 @@ int cstedc_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * int clacrm_(integer *, integer *, complex *, integer *, real *, integer *, complex *, integer *, real *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer finish; extern /* Subroutine */ @@ -290,6 +290,9 @@ int cstedc_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * --iwork; /* Function Body */ *info = 0; + lwmin = 0; + lrwmin = 0; + liwmin = 0; lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1; if (lsame_(compz, "N")) { @@ -380,7 +383,7 @@ int cstedc_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CSTEDC", &i__1); + xerbla_("CSTEDC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cstein.c b/src/map/lapack2flamec/f2c/c/cstein.c index 7af52bf7d..1f71404c9 100644 --- a/src/map/lapack2flamec/f2c/c/cstein.c +++ b/src/map/lapack2flamec/f2c/c/cstein.c @@ -203,7 +203,7 @@ int cstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock integer indrv1, indrv2, indrv3, indrv4, indrv5; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slagtf_( integer *, real *, real *, real *, real *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slagtf_( integer *, real *, real *, real *, real *, real *, real *, integer *, integer *); integer nrmchk; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ @@ -250,6 +250,11 @@ int cstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock --ifail; /* Function Body */ *info = 0; + stpcrt = 0.f; + onenrm = 0.f; + ortol = 0.f; + gpind= 0; + xjm = 0.f; i__1 = *m; for (i__ = 1; i__ <= i__1; @@ -295,7 +300,7 @@ int cstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock if (*info != 0) { i__1 = -(*info); - xerbla_("CSTEIN", &i__1); + xerbla_("CSTEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cstemr.c b/src/map/lapack2flamec/f2c/c/cstemr.c index 8bdcc5036..79f181d67 100644 --- a/src/map/lapack2flamec/f2c/c/cstemr.c +++ b/src/map/lapack2flamec/f2c/c/cstemr.c @@ -393,7 +393,7 @@ int cstemr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r integer wbegin; real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer inderr, iindwk, indgrs, offset; extern /* Subroutine */ @@ -564,7 +564,7 @@ int cstemr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r if (*info != 0) { i__1 = -(*info); - xerbla_("CSTEMR", &i__1); + xerbla_("CSTEMR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csteqr.c b/src/map/lapack2flamec/f2c/c/csteqr.c index 7b3f84ca9..87045f5b9 100644 --- a/src/map/lapack2flamec/f2c/c/csteqr.c +++ b/src/map/lapack2flamec/f2c/c/csteqr.c @@ -179,7 +179,7 @@ int csteqr_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -253,7 +253,7 @@ int csteqr_(char *compz, integer *n, real *d__, real *e, complex *z__, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("CSTEQR", &i__1); + xerbla_("CSTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csycon.c b/src/map/lapack2flamec/f2c/c/csycon.c index 9b03d90e2..ff2efa911 100644 --- a/src/map/lapack2flamec/f2c/c/csycon.c +++ b/src/map/lapack2flamec/f2c/c/csycon.c @@ -133,7 +133,7 @@ int csycon_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, rea integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csytrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -188,7 +188,7 @@ int csycon_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, rea if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCON", &i__1); + xerbla_("CSYCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csycon_3.c b/src/map/lapack2flamec/f2c/c/csycon_3.c index 0e780ea52..33c7e7bc0 100644 --- a/src/map/lapack2flamec/f2c/c/csycon_3.c +++ b/src/map/lapack2flamec/f2c/c/csycon_3.c @@ -177,7 +177,7 @@ int csycon_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int csycon_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCON_3", &i__1); + xerbla_("CSYCON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csycon_rook.c b/src/map/lapack2flamec/f2c/c/csycon_rook.c index 9db19c005..7f516eea0 100644 --- a/src/map/lapack2flamec/f2c/c/csycon_rook.c +++ b/src/map/lapack2flamec/f2c/c/csycon_rook.c @@ -149,7 +149,7 @@ int csycon_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer isave[3]; logical upper; extern /* Subroutine */ - int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(char *, integer *); + int clacn2_(integer *, complex *, complex *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; /* -- LAPACK computational routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -202,7 +202,7 @@ int csycon_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCON_ROOK", &i__1); + xerbla_("CSYCON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyconv.c b/src/map/lapack2flamec/f2c/c/csyconv.c index 62066d0c6..7d0537122 100644 --- a/src/map/lapack2flamec/f2c/c/csyconv.c +++ b/src/map/lapack2flamec/f2c/c/csyconv.c @@ -121,7 +121,7 @@ int csyconv_(char *uplo, char *way, integer *n, complex *a, integer *lda, intege extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -168,7 +168,7 @@ int csyconv_(char *uplo, char *way, integer *n, complex *a, integer *lda, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCONV", &i__1); + xerbla_("CSYCONV", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyconvf.c b/src/map/lapack2flamec/f2c/c/csyconvf.c index 26e81cea8..c9d7a9427 100644 --- a/src/map/lapack2flamec/f2c/c/csyconvf.c +++ b/src/map/lapack2flamec/f2c/c/csyconvf.c @@ -220,7 +220,7 @@ int csyconvf_(char *uplo, char *way, integer *n, complex *a, integer *lda, compl int cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -267,7 +267,7 @@ int csyconvf_(char *uplo, char *way, integer *n, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCONVF", &i__1); + xerbla_("CSYCONVF", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyconvf_rook.c b/src/map/lapack2flamec/f2c/c/csyconvf_rook.c index 996015203..14f3d8932 100644 --- a/src/map/lapack2flamec/f2c/c/csyconvf_rook.c +++ b/src/map/lapack2flamec/f2c/c/csyconvf_rook.c @@ -212,7 +212,7 @@ int csyconvf_rook_(char *uplo, char *way, integer *n, complex *a, integer *lda, int cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -259,7 +259,7 @@ int csyconvf_rook_(char *uplo, char *way, integer *n, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CSYCONVF_ROOK", &i__1); + xerbla_("CSYCONVF_ROOK", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyequb.c b/src/map/lapack2flamec/f2c/c/csyequb.c index c2902b4ed..453ac972f 100644 --- a/src/map/lapack2flamec/f2c/c/csyequb.c +++ b/src/map/lapack2flamec/f2c/c/csyequb.c @@ -142,7 +142,7 @@ int csyequb_(char *uplo, integer *n, complex *a, integer * lda, real *s, real *s real sumsq; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int classq_(integer *, complex *, integer *, real *, real *); @@ -194,7 +194,7 @@ int csyequb_(char *uplo, integer *n, complex *a, integer * lda, real *s, real *s if (*info != 0) { i__1 = -(*info); - xerbla_("CSYEQUB", &i__1); + xerbla_("CSYEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csymv.c b/src/map/lapack2flamec/f2c/c/csymv.c index 35b42bded..26a93d119 100644 --- a/src/map/lapack2flamec/f2c/c/csymv.c +++ b/src/map/lapack2flamec/f2c/c/csymv.c @@ -163,7 +163,7 @@ int csymv_(char *uplo, integer *n, complex *alpha, complex * a, integer *lda, co complex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -215,7 +215,7 @@ int csymv_(char *uplo, integer *n, complex *alpha, complex * a, integer *lda, co } if (info != 0) { - xerbla_("CSYMV ", &info); + xerbla_("CSYMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyr.c b/src/map/lapack2flamec/f2c/c/csyr.c index 43a0b4264..5275daea9 100644 --- a/src/map/lapack2flamec/f2c/c/csyr.c +++ b/src/map/lapack2flamec/f2c/c/csyr.c @@ -141,7 +141,7 @@ int csyr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com complex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -170,6 +170,7 @@ int csyr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com a -= a_offset; /* Function Body */ info = 0; + kx= 0; if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { info = 1; @@ -188,7 +189,7 @@ int csyr_(char *uplo, integer *n, complex *alpha, complex *x, integer *incx, com } if (info != 0) { - xerbla_("CSYR ", &info); + xerbla_("CSYR ", &info, (ftnlen)5); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyrfs.c b/src/map/lapack2flamec/f2c/c/csyrfs.c index 4ea6a0f4e..4efb05c25 100644 --- a/src/map/lapack2flamec/f2c/c/csyrfs.c +++ b/src/map/lapack2flamec/f2c/c/csyrfs.c @@ -220,7 +220,7 @@ int csyrfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int csytrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -303,7 +303,7 @@ int csyrfs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CSYRFS", &i__1); + xerbla_("CSYRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csyrfsx.c b/src/map/lapack2flamec/f2c/c/csyrfsx.c index 1a873797d..501fc094b 100644 --- a/src/map/lapack2flamec/f2c/c/csyrfsx.c +++ b/src/map/lapack2flamec/f2c/c/csyrfsx.c @@ -428,7 +428,7 @@ int csyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in logical rcequ; extern real cla_syrcond_c_(char *, integer *, complex *, integer *, complex *, integer *, integer *, real *, logical *, integer *, complex *, real *), cla_syrcond_x_(char *, integer *, complex *, integer *, complex *, integer *, integer *, complex *, integer *, complex *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real clansy_(char *, char *, integer *, complex *, integer *, real *); extern /* Subroutine */ int csycon_(char *, integer *, complex *, integer *, integer *, real *, real *, complex *, integer *); @@ -579,7 +579,7 @@ int csyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CSYRFSX", &i__1); + xerbla_("CSYRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysv.c b/src/map/lapack2flamec/f2c/c/csysv.c index 2819c9690..7e1b4c9d6 100644 --- a/src/map/lapack2flamec/f2c/c/csysv.c +++ b/src/map/lapack2flamec/f2c/c/csysv.c @@ -168,7 +168,7 @@ int csysv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, inte /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), csytrf_( char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), csytrf_( char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -244,7 +244,7 @@ int csysv_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSV ", &i__1); + xerbla_("CSYSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysv_aa.c b/src/map/lapack2flamec/f2c/c/csysv_aa.c index 330dcede1..41c0c797f 100644 --- a/src/map/lapack2flamec/f2c/c/csysv_aa.c +++ b/src/map/lapack2flamec/f2c/c/csysv_aa.c @@ -171,7 +171,7 @@ int csysv_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, i extern logical lsame_(char *, char *); integer lwkopt_sytrf__, lwkopt_sytrs__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -248,7 +248,7 @@ int csysv_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSV_AA ", &i__1); + xerbla_("CSYSV_AA ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/csysv_aa_2stage.c index f1284cffa..7773dde94 100644 --- a/src/map/lapack2flamec/f2c/c/csysv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/csysv_aa_2stage.c @@ -196,7 +196,7 @@ int csysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -270,7 +270,7 @@ int csysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSV_AA_2STAGE", &i__1); + xerbla_("CSYSV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysv_rk.c b/src/map/lapack2flamec/f2c/c/csysv_rk.c index 12032bb60..323c97b7f 100644 --- a/src/map/lapack2flamec/f2c/c/csysv_rk.c +++ b/src/map/lapack2flamec/f2c/c/csysv_rk.c @@ -228,7 +228,7 @@ int csysv_rk_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c int csytrs_3_(char *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *), csytrf_rk_(char *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine -- */ @@ -303,7 +303,7 @@ int csysv_rk_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSV_RK ", &i__1); + xerbla_("CSYSV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysv_rook.c b/src/map/lapack2flamec/f2c/c/csysv_rook.c index b0b4ca66e..20b4ee7f9 100644 --- a/src/map/lapack2flamec/f2c/c/csysv_rook.c +++ b/src/map/lapack2flamec/f2c/c/csysv_rook.c @@ -202,7 +202,7 @@ int csysv_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, int csytrf_rook_(char *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), csytrs_rook_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine -- */ @@ -276,7 +276,7 @@ int csysv_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSV_ROOK ", &i__1); + xerbla_("CSYSV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysvx.c b/src/map/lapack2flamec/f2c/c/csysvx.c index 3c844ad30..09e532536 100644 --- a/src/map/lapack2flamec/f2c/c/csysvx.c +++ b/src/map/lapack2flamec/f2c/c/csysvx.c @@ -294,7 +294,7 @@ int csysvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern real clansy_(char *, char *, integer *, complex *, integer *, real *); extern /* Subroutine */ @@ -408,7 +408,7 @@ int csysvx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSVX", &i__1); + xerbla_("CSYSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csysvxx.c b/src/map/lapack2flamec/f2c/c/csysvxx.c index 5effa1b1f..410f7361c 100644 --- a/src/map/lapack2flamec/f2c/c/csysvxx.c +++ b/src/map/lapack2flamec/f2c/c/csysvxx.c @@ -528,7 +528,7 @@ int csysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -678,7 +678,7 @@ int csysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CSYSVXX", &i__1); + xerbla_("CSYSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytf2.c b/src/map/lapack2flamec/f2c/c/csytf2.c index f5dee9f78..095824b98 100644 --- a/src/map/lapack2flamec/f2c/c/csytf2.c +++ b/src/map/lapack2flamec/f2c/c/csytf2.c @@ -220,7 +220,7 @@ int csytf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int real absakk; extern integer icamax_(integer *, complex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax; extern logical sisnan_(real *); real rowmax; @@ -256,6 +256,8 @@ int csytf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -272,7 +274,7 @@ int csytf2_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, int if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTF2", &i__1); + xerbla_("CSYTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytf2_rk.c b/src/map/lapack2flamec/f2c/c/csytf2_rk.c index db0743f2d..8bcf8bbfd 100644 --- a/src/map/lapack2flamec/f2c/c/csytf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/csytf2_rk.c @@ -277,7 +277,7 @@ int csytf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -312,6 +312,8 @@ int csytf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -328,7 +330,7 @@ int csytf2_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTF2_RK", &i__1); + xerbla_("CSYTF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytf2_rook.c b/src/map/lapack2flamec/f2c/c/csytf2_rook.c index 38b9e3235..7de789888 100644 --- a/src/map/lapack2flamec/f2c/c/csytf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/csytf2_rook.c @@ -227,7 +227,7 @@ int csytf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real colmax, rowmax; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -261,6 +261,8 @@ int csytf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv --ipiv; /* Function Body */ *info = 0; + imax = 0; + jmax = 0; upper = lsame_(uplo, "U"); if (! upper && ! lsame_(uplo, "L")) { @@ -277,7 +279,7 @@ int csytf2_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTF2_ROOK", &i__1); + xerbla_("CSYTF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrf.c b/src/map/lapack2flamec/f2c/c/csytrf.c index b8e2d68c5..f70e6d701 100644 --- a/src/map/lapack2flamec/f2c/c/csytrf.c +++ b/src/map/lapack2flamec/f2c/c/csytrf.c @@ -194,7 +194,7 @@ int csytrf_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int csytf2_(char *, integer *, complex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int csytf2_(char *, integer *, complex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int clasyf_(char *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -256,7 +256,7 @@ int csytrf_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRF", &i__1); + xerbla_("CSYTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrf_aa.c b/src/map/lapack2flamec/f2c/c/csytrf_aa.c index cf79ff1f0..ec76b9a90 100644 --- a/src/map/lapack2flamec/f2c/c/csytrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/csytrf_aa.c @@ -152,7 +152,7 @@ int csytrf_aa_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -218,7 +218,7 @@ int csytrf_aa_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRF_AA", &i__1); + xerbla_("CSYTRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/csytrf_aa_2stage.c index ff631ca61..79b7f4555 100644 --- a/src/map/lapack2flamec/f2c/c/csytrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/csytrf_aa_2stage.c @@ -189,7 +189,7 @@ int csytrf_aa_2stage_(char *uplo, integer *n, complex *a, integer *lda, complex int ccopy_(integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), cgetrf_( integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_( char *, integer *); + int cgbtrf_(integer *, integer *, integer *, integer *, complex *, integer *, integer *, integer *), cgetrf_( integer *, integer *, complex *, integer *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical tquery, wquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -248,7 +248,7 @@ int csytrf_aa_2stage_(char *uplo, integer *n, complex *a, integer *lda, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRF_AA_2STAGE", &i__1); + xerbla_("CSYTRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrf_rk.c b/src/map/lapack2flamec/f2c/c/csytrf_rk.c index d81d580e9..b414c0821 100644 --- a/src/map/lapack2flamec/f2c/c/csytrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/csytrf_rk.c @@ -275,7 +275,7 @@ int csytrf_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in int cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -336,7 +336,7 @@ int csytrf_rk_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRF_RK", &i__1); + xerbla_("CSYTRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrf_rook.c b/src/map/lapack2flamec/f2c/c/csytrf_rook.c index 350355c14..f1b41c6c9 100644 --- a/src/map/lapack2flamec/f2c/c/csytrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/csytrf_rook.c @@ -220,7 +220,7 @@ int csytrf_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -283,7 +283,7 @@ int csytrf_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRF_ROOK", &i__1); + xerbla_("CSYTRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri.c b/src/map/lapack2flamec/f2c/c/csytri.c index c552ad74d..4ba76ebf4 100644 --- a/src/map/lapack2flamec/f2c/c/csytri.c +++ b/src/map/lapack2flamec/f2c/c/csytri.c @@ -148,7 +148,7 @@ int csytri_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com integer kstep; logical upper; extern /* Subroutine */ - int csymv_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer * ), xerbla_(char *, integer *); + int csymv_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -194,7 +194,7 @@ int csytri_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv, com if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI", &i__1); + xerbla_("CSYTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri2.c b/src/map/lapack2flamec/f2c/c/csytri2.c index 1ea7552ec..b83663991 100644 --- a/src/map/lapack2flamec/f2c/c/csytri2.c +++ b/src/map/lapack2flamec/f2c/c/csytri2.c @@ -141,7 +141,7 @@ int csytri2_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, c integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int csytri_(char *, integer *, complex *, integer *, integer *, complex *, integer *); @@ -204,7 +204,7 @@ int csytri2_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, c if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI2", &i__1); + xerbla_("CSYTRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri2x.c b/src/map/lapack2flamec/f2c/c/csytri2x.c index cdb22c777..a6f41d62b 100644 --- a/src/map/lapack2flamec/f2c/c/csytri2x.c +++ b/src/map/lapack2flamec/f2c/c/csytri2x.c @@ -157,7 +157,7 @@ int csytri2x_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, logical upper; complex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), ctrtri_( char *, char *, integer *, complex *, integer *, integer *), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctrtri_( char *, char *, integer *, complex *, integer *, integer *), csyconv_(char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); complex u01_ip1_j__, u11_ip1_j__; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -207,7 +207,7 @@ int csytri2x_(char *uplo, integer *n, complex *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI2X", &i__1); + xerbla_("CSYTRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri_3.c b/src/map/lapack2flamec/f2c/c/csytri_3.c index af117a628..f1cc55a02 100644 --- a/src/map/lapack2flamec/f2c/c/csytri_3.c +++ b/src/map/lapack2flamec/f2c/c/csytri_3.c @@ -184,7 +184,7 @@ int csytri_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -243,7 +243,7 @@ int csytri_3_(char *uplo, integer *n, complex *a, integer * lda, complex *e, int if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI_3", &i__1); + xerbla_("CSYTRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri_3x.c b/src/map/lapack2flamec/f2c/c/csytri_3x.c index f92045cd7..8b31fa542 100644 --- a/src/map/lapack2flamec/f2c/c/csytri_3x.c +++ b/src/map/lapack2flamec/f2c/c/csytri_3x.c @@ -195,7 +195,7 @@ int csytri_3x_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in logical upper; complex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int ctrtri_(char *, char *, integer *, complex *, integer *, integer *); @@ -249,7 +249,7 @@ int csytri_3x_(char *uplo, integer *n, complex *a, integer * lda, complex *e, in if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI_3X", &i__1); + xerbla_("CSYTRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytri_rook.c b/src/map/lapack2flamec/f2c/c/csytri_rook.c index 40dccdced..9d692d676 100644 --- a/src/map/lapack2flamec/f2c/c/csytri_rook.c +++ b/src/map/lapack2flamec/f2c/c/csytri_rook.c @@ -162,7 +162,7 @@ int csytri_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv integer kstep; logical upper; extern /* Subroutine */ - int csymv_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer * ), xerbla_(char *, integer *); + int csymv_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -208,7 +208,7 @@ int csytri_rook_(char *uplo, integer *n, complex *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRI_ROOK", &i__1); + xerbla_("CSYTRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs.c b/src/map/lapack2flamec/f2c/c/csytrs.c index c3c9a0153..af5eda8f0 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs.c +++ b/src/map/lapack2flamec/f2c/c/csytrs.c @@ -144,7 +144,7 @@ int csytrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, in int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -199,7 +199,7 @@ int csytrs_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, in if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS", &i__1); + xerbla_("CSYTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs2.c b/src/map/lapack2flamec/f2c/c/csytrs2.c index 58f893f80..5864c013f 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs2.c +++ b/src/map/lapack2flamec/f2c/c/csytrs2.c @@ -155,7 +155,7 @@ int csytrs2_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, i int cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), csyconv_( char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), csyconv_( char *, char *, integer *, complex *, integer *, integer *, complex *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -211,7 +211,7 @@ int csytrs2_(char *uplo, integer *n, integer *nrhs, complex * a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS2", &i__1); + xerbla_("CSYTRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs_3.c b/src/map/lapack2flamec/f2c/c/csytrs_3.c index 46ce10732..f9ff2cf23 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs_3.c +++ b/src/map/lapack2flamec/f2c/c/csytrs_3.c @@ -188,7 +188,7 @@ int csytrs_3_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c int cswap_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -244,7 +244,7 @@ int csytrs_3_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS_3", &i__1); + xerbla_("CSYTRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs_aa.c b/src/map/lapack2flamec/f2c/c/csytrs_aa.c index 5de2f3a04..5ed0b41e6 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/csytrs_aa.c @@ -145,7 +145,7 @@ int csytrs_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, int cswap_(integer *, complex *, integer *, complex *, integer *), cgtsv_(integer *, integer *, complex *, complex *, complex *, complex *, integer *, integer *), ctrsm_( char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -213,7 +213,7 @@ int csytrs_aa_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS_AA", &i__1); + xerbla_("CSYTRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/csytrs_aa_2stage.c index 285bb22d6..2bc8682a9 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/csytrs_aa_2stage.c @@ -155,7 +155,7 @@ int csytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cgbtrs_( char *, integer *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -215,7 +215,7 @@ int csytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS_AA_2STAGE", &i__1); + xerbla_("CSYTRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/csytrs_rook.c b/src/map/lapack2flamec/f2c/c/csytrs_rook.c index a58250a80..aac0ef0a5 100644 --- a/src/map/lapack2flamec/f2c/c/csytrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/csytrs_rook.c @@ -158,7 +158,7 @@ int csytrs_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), cgeru_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *), cswap_(integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -213,7 +213,7 @@ int csytrs_rook_(char *uplo, integer *n, integer *nrhs, complex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("CSYTRS_ROOK", &i__1); + xerbla_("CSYTRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctbcon.c b/src/map/lapack2flamec/f2c/c/ctbcon.c index 0f92db5c8..6a0acd35e 100644 --- a/src/map/lapack2flamec/f2c/c/ctbcon.c +++ b/src/map/lapack2flamec/f2c/c/ctbcon.c @@ -164,7 +164,7 @@ int ctbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, complex extern integer icamax_(integer *, complex *, integer *); extern real clantb_(char *, char *, char *, integer *, integer *, complex *, integer *, real *), slamch_(char *); extern /* Subroutine */ - int clatbs_(char *, char *, char *, char *, integer *, integer *, complex *, integer *, complex *, real *, real *, integer *), xerbla_(char *, integer *); + int clatbs_(char *, char *, char *, char *, integer *, integer *, complex *, integer *, complex *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int csrscl_(integer *, real *, complex *, integer *); @@ -237,7 +237,7 @@ int ctbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CTBCON", &i__1); + xerbla_("CTBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctbrfs.c b/src/map/lapack2flamec/f2c/c/ctbrfs.c index 214c6ad6b..43ae6b41d 100644 --- a/src/map/lapack2flamec/f2c/c/ctbrfs.c +++ b/src/map/lapack2flamec/f2c/c/ctbrfs.c @@ -213,7 +213,7 @@ int ctbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -303,7 +303,7 @@ int ctbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CTBRFS", &i__1); + xerbla_("CTBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctbtrs.c b/src/map/lapack2flamec/f2c/c/ctbtrs.c index 5dc75b04b..04db1c8d9 100644 --- a/src/map/lapack2flamec/f2c/c/ctbtrs.c +++ b/src/map/lapack2flamec/f2c/c/ctbtrs.c @@ -157,7 +157,7 @@ int ctbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege int ctbsv_(char *, char *, char *, integer *, integer *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -226,7 +226,7 @@ int ctbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CTBTRS", &i__1); + xerbla_("CTBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctfsm.c b/src/map/lapack2flamec/f2c/c/ctfsm.c index e683b0a48..30d6e3d64 100644 --- a/src/map/lapack2flamec/f2c/c/ctfsm.c +++ b/src/map/lapack2flamec/f2c/c/ctfsm.c @@ -316,7 +316,7 @@ int ctfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical misodd, nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -385,7 +385,7 @@ int ctfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege if (info != 0) { i__1 = -info; - xerbla_("CTFSM ", &i__1); + xerbla_("CTFSM ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctftri.c b/src/map/lapack2flamec/f2c/c/ctftri.c index c7cf5b8d5..4b0ebd2ca 100644 --- a/src/map/lapack2flamec/f2c/c/ctftri.c +++ b/src/map/lapack2flamec/f2c/c/ctftri.c @@ -243,7 +243,7 @@ int ctftri_(char *transr, char *uplo, char *diag, integer *n, complex *a, intege int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int ctrtri_(char *, char *, integer *, complex *, integer *, integer *); @@ -290,7 +290,7 @@ int ctftri_(char *transr, char *uplo, char *diag, integer *n, complex *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CTFTRI", &i__1); + xerbla_("CTFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctfttp.c b/src/map/lapack2flamec/f2c/c/ctfttp.c index 09ea70f67..d959ea9b3 100644 --- a/src/map/lapack2flamec/f2c/c/ctfttp.c +++ b/src/map/lapack2flamec/f2c/c/ctfttp.c @@ -216,12 +216,12 @@ int ctfttp_(char *transr, char *uplo, integer *n, complex * arf, complex *ap, in /* Builtin functions */ void r_cnjg(complex *, complex *); /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -264,7 +264,7 @@ int ctfttp_(char *transr, char *uplo, integer *n, complex * arf, complex *ap, in if (*info != 0) { i__1 = -(*info); - xerbla_("CTFTTP", &i__1); + xerbla_("CTFTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -290,8 +290,6 @@ int ctfttp_(char *transr, char *uplo, integer *n, complex * arf, complex *ap, in AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } - /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/ctfttr.c b/src/map/lapack2flamec/f2c/c/ctfttr.c index 40fc223d3..38e7de551 100644 --- a/src/map/lapack2flamec/f2c/c/ctfttr.c +++ b/src/map/lapack2flamec/f2c/c/ctfttr.c @@ -228,7 +228,7 @@ int ctfttr_(char *transr, char *uplo, integer *n, complex * arf, complex *a, int extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -278,7 +278,7 @@ int ctfttr_(char *transr, char *uplo, integer *n, complex * arf, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CTFTTR", &i__1); + xerbla_("CTFTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgevc.c b/src/map/lapack2flamec/f2c/c/ctgevc.c index a6249505d..21d3645bd 100644 --- a/src/map/lapack2flamec/f2c/c/ctgevc.c +++ b/src/map/lapack2flamec/f2c/c/ctgevc.c @@ -274,12 +274,12 @@ int ctgevc_(char *side, char *howmny, logical *select, integer *n, complex *s, i int slabad_(real *, real *); real ascale, bscale; extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); extern real slamch_(char *); complex salpha; real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical ilcomp; integer ihwmny; @@ -325,6 +325,8 @@ int ctgevc_(char *side, char *howmny, logical *select, integer *n, complex *s, i --work; --rwork; /* Function Body */ + ilall = FALSE_; + ilback = FALSE_; if (lsame_(howmny, "A")) { ihwmny = 1; @@ -393,7 +395,7 @@ int ctgevc_(char *side, char *howmny, logical *select, integer *n, complex *s, i if (*info != 0) { i__1 = -(*info); - xerbla_("CTGEVC", &i__1); + xerbla_("CTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -449,7 +451,7 @@ int ctgevc_(char *side, char *howmny, logical *select, integer *n, complex *s, i if (*info != 0) { i__1 = -(*info); - xerbla_("CTGEVC", &i__1); + xerbla_("CTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgexc.c b/src/map/lapack2flamec/f2c/c/ctgexc.c index f8a973222..ac970213e 100644 --- a/src/map/lapack2flamec/f2c/c/ctgexc.c +++ b/src/map/lapack2flamec/f2c/c/ctgexc.c @@ -208,7 +208,7 @@ int ctgexc_(logical *wantq, logical *wantz, integer *n, complex *a, integer *lda /* Local variables */ integer here; extern /* Subroutine */ - int ctgex2_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int ctgex2_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -272,7 +272,7 @@ int ctgexc_(logical *wantq, logical *wantz, integer *n, complex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("CTGEXC", &i__1); + xerbla_("CTGEXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgsen.c b/src/map/lapack2flamec/f2c/c/ctgsen.c index b30f21f3f..9c5172f89 100644 --- a/src/map/lapack2flamec/f2c/c/ctgsen.c +++ b/src/map/lapack2flamec/f2c/c/ctgsen.c @@ -467,7 +467,7 @@ int ctgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *); real safmin; extern /* Subroutine */ - int ctgexc_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *), xerbla_( char *, integer *), classq_(integer *, complex *, integer *, real *, real *); + int ctgexc_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), classq_(integer *, complex *, integer *, real *, real *); integer liwmin; extern /* Subroutine */ int ctgsyl_(char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, integer *, integer *, integer *); @@ -542,7 +542,7 @@ int ctgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSEN", &i__1); + xerbla_("CTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -628,7 +628,7 @@ int ctgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSEN", &i__1); + xerbla_("CTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgsja.c b/src/map/lapack2flamec/f2c/c/ctgsja.c index aa0b5aef1..fb20e812f 100644 --- a/src/map/lapack2flamec/f2c/c/ctgsja.c +++ b/src/map/lapack2flamec/f2c/c/ctgsja.c @@ -423,7 +423,7 @@ int ctgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer int clags2_(logical *, real *, complex *, real *, real *, complex *, real *, real *, complex *, real *, complex *, real *, complex *), clapll_(integer *, complex *, integer *, complex *, integer *, real *), csscal_(integer *, real *, complex *, integer *); integer kcycle; extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *), slartg_(real *, real *, real *, real *, real * ); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slartg_(real *, real *, real *, real *, real * ); real hugenum; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -520,7 +520,7 @@ int ctgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSJA", &i__1); + xerbla_("CTGSJA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgsna.c b/src/map/lapack2flamec/f2c/c/ctgsna.c index ed134d3b4..4b41b104f 100644 --- a/src/map/lapack2flamec/f2c/c/ctgsna.c +++ b/src/map/lapack2flamec/f2c/c/ctgsna.c @@ -357,7 +357,7 @@ int ctgsna_(char *job, char *howmny, logical *select, integer *n, complex *a, in int slabad_(real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), ctgexc_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), ctgexc_(logical *, logical *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical wantbh, wantdf, somcon; extern /* Subroutine */ @@ -489,7 +489,7 @@ int ctgsna_(char *job, char *howmny, logical *select, integer *n, complex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSNA", &i__1); + xerbla_("CTGSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgsy2.c b/src/map/lapack2flamec/f2c/c/ctgsy2.c index 34b04136f..362dacee7 100644 --- a/src/map/lapack2flamec/f2c/c/ctgsy2.c +++ b/src/map/lapack2flamec/f2c/c/ctgsy2.c @@ -275,7 +275,7 @@ int ctgsy2_(char *trans, integer *ijob, integer *m, integer * n, complex *a, int int caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), cgesc2_(integer *, complex *, integer *, complex *, integer *, integer *, real *), cgetc2_( integer *, complex *, integer *, integer *, integer *, integer *), clatdf_(integer *, integer *, complex *, integer *, complex *, real *, real *, integer *, integer *); real scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -372,7 +372,7 @@ int ctgsy2_(char *trans, integer *ijob, integer *m, integer * n, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSY2", &i__1); + xerbla_("CTGSY2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctgsyl.c b/src/map/lapack2flamec/f2c/c/ctgsyl.c index 6847e2b9c..05d1022cd 100644 --- a/src/map/lapack2flamec/f2c/c/ctgsyl.c +++ b/src/map/lapack2flamec/f2c/c/ctgsyl.c @@ -328,7 +328,7 @@ int ctgsyl_(char *trans, integer *ijob, integer *m, integer * n, complex *a, int int ctgsy2_(char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, integer *); real dscale, scaloc; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer iround; logical notran; @@ -380,6 +380,7 @@ int ctgsyl_(char *trans, integer *ijob, integer *m, integer * n, complex *a, int --iwork; /* Function Body */ *info = 0; + scale2 = 0.f; notran = lsame_(trans, "N"); lquery = *lwork == -1; if (! notran && ! lsame_(trans, "C")) @@ -458,7 +459,7 @@ int ctgsyl_(char *trans, integer *ijob, integer *m, integer * n, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CTGSYL", &i__1); + xerbla_("CTGSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpcon.c b/src/map/lapack2flamec/f2c/c/ctpcon.c index 741dd5729..ab179208e 100644 --- a/src/map/lapack2flamec/f2c/c/ctpcon.c +++ b/src/map/lapack2flamec/f2c/c/ctpcon.c @@ -151,7 +151,7 @@ int ctpcon_(char *norm, char *uplo, char *diag, integer *n, complex *ap, real *r extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real clantp_(char *, char *, char *, integer *, complex *, real *); extern /* Subroutine */ int clatps_(char *, char *, char *, char *, integer *, complex *, complex *, real *, real *, integer *); @@ -217,7 +217,7 @@ int ctpcon_(char *norm, char *uplo, char *diag, integer *n, complex *ap, real *r if (*info != 0) { i__1 = -(*info); - xerbla_("CTPCON", &i__1); + xerbla_("CTPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctplqt.c b/src/map/lapack2flamec/f2c/c/ctplqt.c index 53bf8f9f6..304e75b6c 100644 --- a/src/map/lapack2flamec/f2c/c/ctplqt.c +++ b/src/map/lapack2flamec/f2c/c/ctplqt.c @@ -181,7 +181,7 @@ int ctplqt_(integer *m, integer *n, integer *l, integer *mb, complex *a, integer /* Local variables */ integer i__, ib, lb, nb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctplqt2_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctplqt2_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -242,7 +242,7 @@ int ctplqt_(integer *m, integer *n, integer *l, integer *mb, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CTPLQT", &i__1); + xerbla_("CTPLQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctplqt2.c b/src/map/lapack2flamec/f2c/c/ctplqt2.c index 55f85e927..f11086ca3 100644 --- a/src/map/lapack2flamec/f2c/c/ctplqt2.c +++ b/src/map/lapack2flamec/f2c/c/ctplqt2.c @@ -187,7 +187,7 @@ int ctplqt2_(integer *m, integer *n, integer *l, complex *a, integer *lda, compl int cgerc_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); complex alpha; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -246,7 +246,7 @@ int ctplqt2_(integer *m, integer *n, integer *l, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CTPLQT2", &i__1); + xerbla_("CTPLQT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpmlqt.c b/src/map/lapack2flamec/f2c/c/ctpmlqt.c index 756b2626f..a4aa7873d 100644 --- a/src/map/lapack2flamec/f2c/c/ctpmlqt.c +++ b/src/map/lapack2flamec/f2c/c/ctpmlqt.c @@ -216,7 +216,7 @@ int ctpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -313,7 +313,7 @@ int ctpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CTPMLQT", &i__1); + xerbla_("CTPMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpmqrt.c b/src/map/lapack2flamec/f2c/c/ctpmqrt.c index c6cea1267..01df0d9fe 100644 --- a/src/map/lapack2flamec/f2c/c/ctpmqrt.c +++ b/src/map/lapack2flamec/f2c/c/ctpmqrt.c @@ -229,7 +229,7 @@ int ctpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -328,7 +328,7 @@ int ctpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CTPMQRT", &i__1); + xerbla_("CTPMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpqrt.c b/src/map/lapack2flamec/f2c/c/ctpqrt.c index a54c3b633..2596c8f86 100644 --- a/src/map/lapack2flamec/f2c/c/ctpqrt.c +++ b/src/map/lapack2flamec/f2c/c/ctpqrt.c @@ -193,7 +193,7 @@ int ctpqrt_(integer *m, integer *n, integer *l, integer *nb, complex *a, integer /* Local variables */ integer i__, ib, lb, mb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpqrt2_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ctprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), ctpqrt2_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -254,7 +254,7 @@ int ctpqrt_(integer *m, integer *n, integer *l, integer *nb, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CTPQRT", &i__1); + xerbla_("CTPQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpqrt2.c b/src/map/lapack2flamec/f2c/c/ctpqrt2.c index ba82c7c28..d23e189c9 100644 --- a/src/map/lapack2flamec/f2c/c/ctpqrt2.c +++ b/src/map/lapack2flamec/f2c/c/ctpqrt2.c @@ -196,7 +196,7 @@ int ctpqrt2_(integer *m, integer *n, integer *l, complex *a, integer *lda, compl int cgerc_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); complex alpha; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -255,7 +255,7 @@ int ctpqrt2_(integer *m, integer *n, integer *l, complex *a, integer *lda, compl if (*info != 0) { i__1 = -(*info); - xerbla_("CTPQRT2", &i__1); + xerbla_("CTPQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctprfs.c b/src/map/lapack2flamec/f2c/c/ctprfs.c index 8894df6b0..76043f32e 100644 --- a/src/map/lapack2flamec/f2c/c/ctprfs.c +++ b/src/map/lapack2flamec/f2c/c/ctprfs.c @@ -201,7 +201,7 @@ int ctprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -281,7 +281,7 @@ int ctprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTPRFS", &i__1); + xerbla_("CTPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctptri.c b/src/map/lapack2flamec/f2c/c/ctptri.c index 082387a48..0c87b1383 100644 --- a/src/map/lapack2flamec/f2c/c/ctptri.c +++ b/src/map/lapack2flamec/f2c/c/ctptri.c @@ -140,7 +140,7 @@ int ctptri_(char *uplo, char *diag, integer *n, complex *ap, integer *info) int ctpmv_(char *, char *, char *, integer *, complex *, complex *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jclast; logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -168,6 +168,7 @@ int ctptri_(char *uplo, char *diag, integer *n, complex *ap, integer *info) *info = 0; upper = lsame_(uplo, "U"); nounit = lsame_(diag, "N"); + jclast = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -183,7 +184,7 @@ int ctptri_(char *uplo, char *diag, integer *n, complex *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("CTPTRI", &i__1); + xerbla_("CTPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctptrs.c b/src/map/lapack2flamec/f2c/c/ctptrs.c index 2384f1bc9..021ea9997 100644 --- a/src/map/lapack2flamec/f2c/c/ctptrs.c +++ b/src/map/lapack2flamec/f2c/c/ctptrs.c @@ -140,7 +140,7 @@ int ctptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), xerbla_( char *, integer *); + int ctpsv_(char *, char *, char *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -199,7 +199,7 @@ int ctptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTPTRS", &i__1); + xerbla_("CTPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctpttf.c b/src/map/lapack2flamec/f2c/c/ctpttf.c index 4df998e9a..469c155ea 100644 --- a/src/map/lapack2flamec/f2c/c/ctpttf.c +++ b/src/map/lapack2flamec/f2c/c/ctpttf.c @@ -214,12 +214,12 @@ int ctpttf_(char *transr, char *uplo, integer *n, complex * ap, complex *arf, in /* Builtin functions */ void r_cnjg(complex *, complex *); /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -259,7 +259,7 @@ int ctpttf_(char *transr, char *uplo, integer *n, complex * ap, complex *arf, in if (*info != 0) { i__1 = -(*info); - xerbla_("CTPTTF", &i__1); + xerbla_("CTPTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -285,8 +285,6 @@ int ctpttf_(char *transr, char *uplo, integer *n, complex * ap, complex *arf, in AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } - /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/ctpttr.c b/src/map/lapack2flamec/f2c/c/ctpttr.c index 03ea5cc83..e5a88a462 100644 --- a/src/map/lapack2flamec/f2c/c/ctpttr.c +++ b/src/map/lapack2flamec/f2c/c/ctpttr.c @@ -110,7 +110,7 @@ int ctpttr_(char *uplo, integer *n, complex *ap, complex *a, integer *lda, integ extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -153,7 +153,7 @@ int ctpttr_(char *uplo, integer *n, complex *ap, complex *a, integer *lda, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CTPTTR", &i__1); + xerbla_("CTPTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrcon.c b/src/map/lapack2flamec/f2c/c/ctrcon.c index 07fe9ed05..75058e75d 100644 --- a/src/map/lapack2flamec/f2c/c/ctrcon.c +++ b/src/map/lapack2flamec/f2c/c/ctrcon.c @@ -157,7 +157,7 @@ int ctrcon_(char *norm, char *uplo, char *diag, integer *n, complex *a, integer extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real clantr_(char *, char *, char *, integer *, integer *, complex *, integer *, real *); real ainvnm; extern /* Subroutine */ @@ -227,7 +227,7 @@ int ctrcon_(char *norm, char *uplo, char *diag, integer *n, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CTRCON", &i__1); + xerbla_("CTRCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrevc.c b/src/map/lapack2flamec/f2c/c/ctrevc.c index d58d8680a..709aa47d5 100644 --- a/src/map/lapack2flamec/f2c/c/ctrevc.c +++ b/src/map/lapack2flamec/f2c/c/ctrevc.c @@ -258,7 +258,7 @@ int ctrevc_(char *side, char *howmny, logical *select, integer *n, complex *t, i extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *), clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *); extern real scasum_(integer *, complex *, integer *); logical rightv; real smlnum; @@ -360,7 +360,7 @@ int ctrevc_(char *side, char *howmny, logical *select, integer *n, complex *t, i if (*info != 0) { i__1 = -(*info); - xerbla_("CTREVC", &i__1); + xerbla_("CTREVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrevc3.c b/src/map/lapack2flamec/f2c/c/ctrevc3.c index cc781a883..e9fd33a7e 100644 --- a/src/map/lapack2flamec/f2c/c/ctrevc3.c +++ b/src/map/lapack2flamec/f2c/c/ctrevc3.c @@ -13,7 +13,6 @@ static complex c_b2 = ; static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b CTREVC3 */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -268,8 +267,7 @@ int ctrevc3_(char *side, char *howmny, logical *select, integer *n, complex *t, AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2[2], i__3, i__4, i__5, i__6; + integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__3, i__4, i__5, i__6; real r__1, r__2, r__3; complex q__1, q__2; char ch__1[2]; @@ -294,7 +292,7 @@ int ctrevc3_(char *side, char *howmny, logical *select, integer *n, complex *t, extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_( char *, integer *); + int csscal_(integer *, real *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int clatrs_(char *, char *, char *, char *, integer *, complex *, integer *, complex *, real *, real *, integer *); @@ -421,7 +419,7 @@ int ctrevc3_(char *side, char *howmny, logical *select, integer *n, complex *t, if (*info != 0) { i__1 = -(*info); - xerbla_("CTREVC3", &i__1); + xerbla_("CTREVC3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrexc.c b/src/map/lapack2flamec/f2c/c/ctrexc.c index 7a4e3fba1..debebec3e 100644 --- a/src/map/lapack2flamec/f2c/c/ctrexc.c +++ b/src/map/lapack2flamec/f2c/c/ctrexc.c @@ -140,7 +140,7 @@ int ctrexc_(char *compq, integer *n, complex *t, integer * ldt, complex *q, inte extern logical lsame_(char *, char *); logical wantq; extern /* Subroutine */ - int clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(char *, integer *); + int clartg_(complex *, complex *, real *, complex *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -197,7 +197,7 @@ int ctrexc_(char *compq, integer *n, complex *t, integer * ldt, complex *q, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CTREXC", &i__1); + xerbla_("CTREXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrrfs.c b/src/map/lapack2flamec/f2c/c/ctrrfs.c index 399474c04..2323732c3 100644 --- a/src/map/lapack2flamec/f2c/c/ctrrfs.c +++ b/src/map/lapack2flamec/f2c/c/ctrrfs.c @@ -206,7 +206,7 @@ int ctrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -292,7 +292,7 @@ int ctrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTRRFS", &i__1); + xerbla_("CTRRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrsen.c b/src/map/lapack2flamec/f2c/c/ctrsen.c index eadfa1599..f6f3f75ec 100644 --- a/src/map/lapack2flamec/f2c/c/ctrsen.c +++ b/src/map/lapack2flamec/f2c/c/ctrsen.c @@ -290,7 +290,7 @@ int ctrsen_(char *job, char *compq, logical *select, integer *n, complex *t, int real rwork[1]; extern real clange_(char *, integer *, integer *, complex *, integer *, real *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical wantbh; extern /* Subroutine */ int ctrexc_(char *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *); @@ -336,6 +336,7 @@ int ctrsen_(char *job, char *compq, logical *select, integer *n, complex *t, int wants = lsame_(job, "E") || wantbh; wantsp = lsame_(job, "V") || wantbh; wantq = lsame_(compq, "V"); + lwmin = 0; /* Set M to the number of selected eigenvalues. */ *m = 0; i__1 = *n; @@ -401,7 +402,7 @@ int ctrsen_(char *job, char *compq, logical *select, integer *n, complex *t, int if (*info != 0) { i__1 = -(*info); - xerbla_("CTRSEN", &i__1); + xerbla_("CTRSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrsna.c b/src/map/lapack2flamec/f2c/c/ctrsna.c index 2557c4f4b..249894bba 100644 --- a/src/map/lapack2flamec/f2c/c/ctrsna.c +++ b/src/map/lapack2flamec/f2c/c/ctrsna.c @@ -281,7 +281,7 @@ int ctrsna_(char *job, char *howmny, logical *select, integer *n, complex *t, in extern integer icamax_(integer *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical wantbh; extern /* Subroutine */ @@ -396,7 +396,7 @@ int ctrsna_(char *job, char *howmny, logical *select, integer *n, complex *t, in if (*info != 0) { i__1 = -(*info); - xerbla_("CTRSNA", &i__1); + xerbla_("CTRSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrsyl.c b/src/map/lapack2flamec/f2c/c/ctrsyl.c index 052faea1a..385da4d33 100644 --- a/src/map/lapack2flamec/f2c/c/ctrsyl.c +++ b/src/map/lapack2flamec/f2c/c/ctrsyl.c @@ -184,11 +184,11 @@ int ctrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, com int slabad_(real *, real *); extern real clange_(char *, integer *, integer *, complex *, integer *, real *); extern /* Complex */ - VOID cladiv_(complex *, complex *, complex *); + void cladiv_f2c_(complex *, complex *, complex *); real scaloc; extern real slamch_(char *); extern /* Subroutine */ - int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); + int csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical notrna, notrnb; real smlnum; @@ -264,7 +264,7 @@ int ctrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, com if (*info != 0) { i__1 = -(*info); - xerbla_("CTRSYL", &i__1); + xerbla_("CTRSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrsyl3.c b/src/map/lapack2flamec/f2c/c/ctrsyl3.c index 6a41605ec..4d202e4dc 100644 --- a/src/map/lapack2flamec/f2c/c/ctrsyl3.c +++ b/src/map/lapack2flamec/f2c/c/ctrsyl3.c @@ -174,7 +174,8 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co real buf, sgn, scal; complex csgn; real anrm, bnrm, cnrm; - integer awrk, bwrk, temp; + integer awrk, bwrk; + int temp; real *wnrm; real xnrm; extern /* Subroutine */ @@ -190,7 +191,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co int csscal_(integer *, real *, complex *, integer *); real scamin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern real slarmm_(real *, real *, real *); @@ -293,7 +294,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (*info != 0) { i__1 = -(*info); - xerbla_("CTRSYL3", &i__1); + xerbla_("CTRSYL3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -460,7 +461,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__2 = nbb; @@ -478,7 +479,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -514,7 +515,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -527,15 +528,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -602,7 +603,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -615,15 +616,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -719,7 +720,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__3 = nbb; @@ -737,7 +738,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -774,7 +775,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__4 = nbb; for (jj = 1; @@ -787,15 +788,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -862,7 +863,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__4 = nbb; for (jj = 1; @@ -875,15 +876,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -978,7 +979,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__2 = nbb; @@ -996,7 +997,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -1033,7 +1034,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -1046,15 +1047,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1121,7 +1122,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -1134,15 +1135,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1236,7 +1237,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__1 = nbb; @@ -1254,7 +1255,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -1291,7 +1292,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -1304,15 +1305,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1379,7 +1380,7 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -1392,15 +1393,15 @@ int ctrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, co ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; diff --git a/src/map/lapack2flamec/f2c/c/ctrtrs.c b/src/map/lapack2flamec/f2c/c/ctrtrs.c index 6182e6ec2..9786194cd 100644 --- a/src/map/lapack2flamec/f2c/c/ctrtrs.c +++ b/src/map/lapack2flamec/f2c/c/ctrtrs.c @@ -150,7 +150,7 @@ int ctrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -214,7 +214,7 @@ int ctrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTRTRS", &i__1); + xerbla_("CTRTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrttf.c b/src/map/lapack2flamec/f2c/c/ctrttf.c index 1039a563c..4e117f16a 100644 --- a/src/map/lapack2flamec/f2c/c/ctrttf.c +++ b/src/map/lapack2flamec/f2c/c/ctrttf.c @@ -228,7 +228,7 @@ int ctrttf_(char *transr, char *uplo, integer *n, complex *a, integer *lda, comp extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -278,7 +278,7 @@ int ctrttf_(char *transr, char *uplo, integer *n, complex *a, integer *lda, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTRTTF", &i__1); + xerbla_("CTRTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctrttp.c b/src/map/lapack2flamec/f2c/c/ctrttp.c index f59f9ac6f..398cfae03 100644 --- a/src/map/lapack2flamec/f2c/c/ctrttp.c +++ b/src/map/lapack2flamec/f2c/c/ctrttp.c @@ -111,7 +111,7 @@ int ctrttp_(char *uplo, integer *n, complex *a, integer *lda, complex *ap, integ extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int ctrttp_(char *uplo, integer *n, complex *a, integer *lda, complex *ap, integ if (*info != 0) { i__1 = -(*info); - xerbla_("CTRTTP", &i__1); + xerbla_("CTRTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctzrqf.c b/src/map/lapack2flamec/f2c/c/ctzrqf.c index 92ee4fd7b..41df76c50 100644 --- a/src/map/lapack2flamec/f2c/c/ctzrqf.c +++ b/src/map/lapack2flamec/f2c/c/ctzrqf.c @@ -154,7 +154,7 @@ int ctzrqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, inte int cgerc_(integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); complex alpha; extern /* Subroutine */ - int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *), ccopy_(integer *, complex *, integer *, complex *, integer *), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *), clarfg_(integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -196,7 +196,7 @@ int ctzrqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CTZRQF", &i__1); + xerbla_("CTZRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ctzrzf.c b/src/map/lapack2flamec/f2c/c/ctzrzf.c index f9f351da0..abab9bcef 100644 --- a/src/map/lapack2flamec/f2c/c/ctzrzf.c +++ b/src/map/lapack2flamec/f2c/c/ctzrzf.c @@ -159,7 +159,7 @@ int ctzrzf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp /* Local variables */ integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin; extern /* Subroutine */ - int xerbla_(char *, integer *), clarzb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), clarzb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int clarzt_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clatrz_(integer *, integer *, integer *, complex *, integer *, complex *, complex *); @@ -194,6 +194,7 @@ int ctzrzf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -231,7 +232,7 @@ int ctzrzf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CTZRZF", &i__1); + xerbla_("CTZRZF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb.c b/src/map/lapack2flamec/f2c/c/cunbdb.c index dc53b35c3..8a14b9449 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb.c @@ -312,7 +312,7 @@ int cunbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, comple int caxpy_(integer *, complex *, complex *, integer *, complex *, integer *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int clarfgp_(integer *, complex *, complex *, integer *, complex *); @@ -458,7 +458,7 @@ int cunbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, comple if (*info != 0) { i__1 = -(*info); - xerbla_("xORBDB", &i__1); + xerbla_("xORBDB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb1.c b/src/map/lapack2flamec/f2c/c/cunbdb1.c index 55f7690a7..26120cdb6 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb1.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb1.c @@ -221,7 +221,7 @@ int cunbdb1_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, int csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int cunbdb5_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -317,7 +317,7 @@ int cunbdb1_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB1", &i__1); + xerbla_("CUNBDB1", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb2.c b/src/map/lapack2flamec/f2c/c/cunbdb2.c index a30dba06a..70cb4c21b 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb2.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb2.c @@ -226,7 +226,7 @@ int cunbdb2_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, int csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int cunbdb5_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -322,7 +322,7 @@ int cunbdb2_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB2", &i__1); + xerbla_("CUNBDB2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb3.c b/src/map/lapack2flamec/f2c/c/cunbdb3.c index 990ffa3d6..6ef945bcf 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb3.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb3.c @@ -220,7 +220,7 @@ int cunbdb3_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, int csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int cunbdb5_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -316,7 +316,7 @@ int cunbdb3_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB3", &i__1); + xerbla_("CUNBDB3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb4.c b/src/map/lapack2flamec/f2c/c/cunbdb4.c index 7281d3a9c..52dd61417 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb4.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb4.c @@ -237,7 +237,7 @@ int cunbdb4_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, int csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int cunbdb5_(integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); @@ -335,7 +335,7 @@ int cunbdb4_(integer *m, integer *p, integer *q, complex * x11, integer *ldx11, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB4", &i__1); + xerbla_("CUNBDB4", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb5.c b/src/map/lapack2flamec/f2c/c/cunbdb5.c index ac6ca6413..0d1b1ce25 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb5.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb5.c @@ -160,7 +160,7 @@ int cunbdb5_(integer *m1, integer *m2, integer *n, complex * x1, integer *incx1, integer i__, j, childinfo; extern real scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), cunbdb6_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cunbdb6_( integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer *); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -229,7 +229,7 @@ int cunbdb5_(integer *m1, integer *m2, integer *n, complex * x1, integer *incx1, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB5", &i__1); + xerbla_("CUNBDB5", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunbdb6.c b/src/map/lapack2flamec/f2c/c/cunbdb6.c index a4e74a606..278cbeec2 100644 --- a/src/map/lapack2flamec/f2c/c/cunbdb6.c +++ b/src/map/lapack2flamec/f2c/c/cunbdb6.c @@ -177,7 +177,7 @@ int cunbdb6_(integer *m1, integer *m2, integer *n, complex * x1, integer *incx1, int cgemv_(char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), classq_( integer *, complex *, integer *, real *, real *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), classq_( integer *, complex *, integer *, real *, real *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -245,7 +245,7 @@ int cunbdb6_(integer *m1, integer *m2, integer *n, complex * x1, integer *incx1, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNBDB6", &i__1); + xerbla_("CUNBDB6", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cuncsd.c b/src/map/lapack2flamec/f2c/c/cuncsd.c index ab43f64f5..c51f2a120 100644 --- a/src/map/lapack2flamec/f2c/c/cuncsd.c +++ b/src/map/lapack2flamec/f2c/c/cuncsd.c @@ -339,7 +339,7 @@ int cuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, int cunbdb_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, complex *, complex *, complex *, complex *, complex *, integer *, integer *); integer iorbdb, lorglqworkmin, lorgqrworkmin; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), clapmr_(logical *, integer *, integer *, complex *, integer *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clapmr_(logical *, integer *, integer *, complex *, integer *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *); integer lorglqworkopt; extern /* Subroutine */ int cunglq_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -409,6 +409,21 @@ int cuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, defaultsigns = ! lsame_(signs, "O"); lquery = *lwork == -1; lrquery = *lrwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + itauq2 = 0; + itauq1 = 0; + itaup2 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -7; @@ -659,7 +674,7 @@ int cuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNCSD", &i__1); + xerbla_("CUNCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cuncsd2by1.c b/src/map/lapack2flamec/f2c/c/cuncsd2by1.c index d4f1a13c9..97f286f1a 100644 --- a/src/map/lapack2flamec/f2c/c/cuncsd2by1.c +++ b/src/map/lapack2flamec/f2c/c/cuncsd2by1.c @@ -268,7 +268,7 @@ int cuncsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, int cbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, real *, real *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, real *, real *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *); integer ibbcsd, lbbcsd, iorbdb, lorbdb; extern /* Subroutine */ - int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *), clapmr_(logical *, integer *, integer *, complex *, integer *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *), cunglq_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); + int clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), clapmr_(logical *, integer *, integer *, complex *, integer *, integer *), clapmt_(logical *, integer *, integer *, complex *, integer *, integer *), cunglq_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); integer iorglq; extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -649,7 +649,7 @@ int cuncsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNCSD2BY1", &i__1); + xerbla_("CUNCSD2BY1", &i__1, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cung2l.c b/src/map/lapack2flamec/f2c/c/cung2l.c index 76dd761fa..d02e76fb6 100644 --- a/src/map/lapack2flamec/f2c/c/cung2l.c +++ b/src/map/lapack2flamec/f2c/c/cung2l.c @@ -120,7 +120,7 @@ int cung2l_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int cung2l_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNG2L", &i__1); + xerbla_("CUNG2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cung2r.c b/src/map/lapack2flamec/f2c/c/cung2r.c index 3c33a5c7a..51160dbc7 100644 --- a/src/map/lapack2flamec/f2c/c/cung2r.c +++ b/src/map/lapack2flamec/f2c/c/cung2r.c @@ -120,7 +120,7 @@ int cung2r_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int cung2r_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNG2R", &i__1); + xerbla_("CUNG2R", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungbr.c b/src/map/lapack2flamec/f2c/c/cungbr.c index 40de880e5..b007a8726 100644 --- a/src/map/lapack2flamec/f2c/c/cungbr.c +++ b/src/map/lapack2flamec/f2c/c/cungbr.c @@ -161,7 +161,7 @@ int cungbr_(char *vect, integer *m, integer *n, integer *k, complex *a, integer integer iinfo; logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), cunglq_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), cunglq_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine -- */ @@ -263,7 +263,7 @@ int cungbr_(char *vect, integer *m, integer *n, integer *k, complex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGBR", &i__1); + xerbla_("CUNGBR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunghr.c b/src/map/lapack2flamec/f2c/c/cunghr.c index 0873aa43e..94865d629 100644 --- a/src/map/lapack2flamec/f2c/c/cunghr.c +++ b/src/map/lapack2flamec/f2c/c/cunghr.c @@ -130,7 +130,7 @@ int cunghr_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c /* Local variables */ integer i__, j, nb, nh, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -197,7 +197,7 @@ int cunghr_(integer *n, integer *ilo, integer *ihi, complex * a, integer *lda, c if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGHR", &i__1); + xerbla_("CUNGHR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungl2.c b/src/map/lapack2flamec/f2c/c/cungl2.c index fc5dfbcce..252066df5 100644 --- a/src/map/lapack2flamec/f2c/c/cungl2.c +++ b/src/map/lapack2flamec/f2c/c/cungl2.c @@ -115,7 +115,7 @@ int cungl2_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -162,7 +162,7 @@ int cungl2_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGL2", &i__1); + xerbla_("CUNGL2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunglq.c b/src/map/lapack2flamec/f2c/c/cunglq.c index 5f5c3974a..d928619f3 100644 --- a/src/map/lapack2flamec/f2c/c/cunglq.c +++ b/src/map/lapack2flamec/f2c/c/cunglq.c @@ -133,7 +133,7 @@ int cunglq_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cungl2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cungl2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -194,7 +194,7 @@ int cunglq_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGLQ", &i__1); + xerbla_("CUNGLQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungql.c b/src/map/lapack2flamec/f2c/c/cungql.c index 6ba9de2cf..b6cc1129b 100644 --- a/src/map/lapack2flamec/f2c/c/cungql.c +++ b/src/map/lapack2flamec/f2c/c/cungql.c @@ -133,7 +133,7 @@ int cungql_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ib, nb, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cung2l_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cung2l_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -166,6 +166,7 @@ int cungql_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -204,7 +205,7 @@ int cungql_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGQL", &i__1); + xerbla_("CUNGQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungqr.c b/src/map/lapack2flamec/f2c/c/cungqr.c index 1e4104722..18ce97c0c 100644 --- a/src/map/lapack2flamec/f2c/c/cungqr.c +++ b/src/map/lapack2flamec/f2c/c/cungqr.c @@ -133,7 +133,7 @@ int cungqr_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cung2r_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -194,7 +194,7 @@ int cungqr_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGQR", &i__1); + xerbla_("CUNGQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungr2.c b/src/map/lapack2flamec/f2c/c/cungr2.c index d99db5fb1..6c07cb7b6 100644 --- a/src/map/lapack2flamec/f2c/c/cungr2.c +++ b/src/map/lapack2flamec/f2c/c/cungr2.c @@ -116,7 +116,7 @@ int cungr2_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int cungr2_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGR2", &i__1); + xerbla_("CUNGR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungrq.c b/src/map/lapack2flamec/f2c/c/cungrq.c index 18cdaa2f5..deb242715 100644 --- a/src/map/lapack2flamec/f2c/c/cungrq.c +++ b/src/map/lapack2flamec/f2c/c/cungrq.c @@ -133,7 +133,7 @@ int cungrq_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple /* Local variables */ integer i__, j, l, ib, nb, ii, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cungr2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cungr2_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -166,6 +166,7 @@ int cungrq_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -204,7 +205,7 @@ int cungrq_(integer *m, integer *n, integer *k, complex *a, integer *lda, comple if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGRQ", &i__1); + xerbla_("CUNGRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungtr.c b/src/map/lapack2flamec/f2c/c/cungtr.c index a247e62cc..d00d986ed 100644 --- a/src/map/lapack2flamec/f2c/c/cungtr.c +++ b/src/map/lapack2flamec/f2c/c/cungtr.c @@ -130,7 +130,7 @@ int cungtr_(char *uplo, integer *n, complex *a, integer *lda, complex *tau, comp integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cungql_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cungqr_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -215,7 +215,7 @@ int cungtr_(char *uplo, integer *n, complex *a, integer *lda, complex *tau, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGTR", &i__1); + xerbla_("CUNGTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungtsqr.c b/src/map/lapack2flamec/f2c/c/cungtsqr.c index c9bc0913d..c5cba6f7b 100644 --- a/src/map/lapack2flamec/f2c/c/cungtsqr.c +++ b/src/map/lapack2flamec/f2c/c/cungtsqr.c @@ -189,7 +189,7 @@ int cungtsqr_(integer *m, integer *n, integer *mb, integer * nb, complex *a, int int clamtsqr_(char *, char *, integer *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, integer * ); integer lworkopt, j, lc, lw, ldc, iinfo; extern /* Subroutine */ - int ccopy_(integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int ccopy_(integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer nblocal; /* -- LAPACK computational routine (version 3.9.0) -- */ @@ -282,7 +282,7 @@ int cungtsqr_(integer *m, integer *n, integer *mb, integer * nb, complex *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGTSQR", &i__1); + xerbla_("CUNGTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cungtsqr_row.c b/src/map/lapack2flamec/f2c/c/cungtsqr_row.c index 2beb53fee..ea61e9cdc 100644 --- a/src/map/lapack2flamec/f2c/c/cungtsqr_row.c +++ b/src/map/lapack2flamec/f2c/c/cungtsqr_row.c @@ -201,7 +201,7 @@ int cungtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, complex *a, complex dummy[1] /* was [1][1] */ ; extern /* Subroutine */ - int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + int claset_(char *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer nblocal, kb_last__; /* -- LAPACK computational routine -- */ @@ -282,7 +282,7 @@ int cungtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, complex *a, if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGTSQR_ROW", &i__1); + xerbla_("CUNGTSQR_ROW", &i__1, (ftnlen)12); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/cunhr_col.c b/src/map/lapack2flamec/f2c/c/cunhr_col.c index 3c1c8c184..eb05b01cb 100644 --- a/src/map/lapack2flamec/f2c/c/cunhr_col.c +++ b/src/map/lapack2flamec/f2c/c/cunhr_col.c @@ -280,7 +280,7 @@ int cunhr_col_(integer *m, integer *n, integer *nb, complex *a, integer *lda, co int claunhr_col_getrfnp_(integer *, integer *, complex *, integer *, complex *, integer *), cscal_(integer *, complex *, complex *, integer *); integer iinfo; extern /* Subroutine */ - int ccopy_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ccopy_(integer *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jbtemp1, jbtemp2; /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -341,7 +341,7 @@ int cunhr_col_(integer *m, integer *n, integer *nb, complex *a, integer *lda, co if (*info != 0) { i__1 = -(*info); - xerbla_("CUNHR_COL", &i__1); + xerbla_("CUNHR_COL", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunm22.c b/src/map/lapack2flamec/f2c/c/cunm22.c index 198694a2a..734f93a52 100644 --- a/src/map/lapack2flamec/f2c/c/cunm22.c +++ b/src/map/lapack2flamec/f2c/c/cunm22.c @@ -176,7 +176,7 @@ int cunm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege int cgemm_(char *, char *, integer *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), clacpy_(char *, integer *, integer *, complex *, integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork, lwkopt; logical lquery; @@ -276,7 +276,7 @@ int cunm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege if (*info != 0) { i__1 = -(*info); - xerbla_("CUNM22", &i__1); + xerbla_("CUNM22", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunm2l.c b/src/map/lapack2flamec/f2c/c/cunm2l.c index f8e61cc08..0ab535cb8 100644 --- a/src/map/lapack2flamec/f2c/c/cunm2l.c +++ b/src/map/lapack2flamec/f2c/c/cunm2l.c @@ -170,7 +170,7 @@ int cunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, complex int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -246,7 +246,7 @@ int cunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNM2L", &i__1); + xerbla_("CUNM2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunm2r.c b/src/map/lapack2flamec/f2c/c/cunm2r.c index 7e188c0cd..c4b1e358a 100644 --- a/src/map/lapack2flamec/f2c/c/cunm2r.c +++ b/src/map/lapack2flamec/f2c/c/cunm2r.c @@ -170,7 +170,7 @@ int cunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, complex int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -246,7 +246,7 @@ int cunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNM2R", &i__1); + xerbla_("CUNM2R", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmbr.c b/src/map/lapack2flamec/f2c/c/cunmbr.c index ec4ae90df..47e9ad2a5 100644 --- a/src/map/lapack2flamec/f2c/c/cunmbr.c +++ b/src/map/lapack2flamec/f2c/c/cunmbr.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b CUNMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -199,8 +198,7 @@ int cunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cunmbr inputs: vect %c, side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "",*vect, *side, *trans, *m, *n, *k, *lda, *ldc); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -211,7 +209,7 @@ int cunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmlq_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -354,7 +352,7 @@ int cunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMBR", &i__1); + xerbla_("CUNMBR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmhr.c b/src/map/lapack2flamec/f2c/c/cunmhr.c index 3a353a939..b7e535998 100644 --- a/src/map/lapack2flamec/f2c/c/cunmhr.c +++ b/src/map/lapack2flamec/f2c/c/cunmhr.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b CUNMHR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -177,8 +176,7 @@ int cunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("cunmhr inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "",*side, *trans, *m, *n, *ilo, *ihi, *lda, *ldc); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2; + integer a_dim1, a_offset, c_dim1, c_offset, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -189,7 +187,7 @@ int cunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -291,7 +289,7 @@ int cunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ if (*info != 0) { i__2 = -(*info); - xerbla_("CUNMHR", &i__2); + xerbla_("CUNMHR", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunml2.c b/src/map/lapack2flamec/f2c/c/cunml2.c index eea149497..3cf6c508f 100644 --- a/src/map/lapack2flamec/f2c/c/cunml2.c +++ b/src/map/lapack2flamec/f2c/c/cunml2.c @@ -167,7 +167,7 @@ int cunml2_(char *side, char *trans, integer *m, integer *n, integer *k, complex int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -243,7 +243,7 @@ int cunml2_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNML2", &i__1); + xerbla_("CUNML2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmlq.c b/src/map/lapack2flamec/f2c/c/cunmlq.c index a53294115..69130c002 100644 --- a/src/map/lapack2flamec/f2c/c/cunmlq.c +++ b/src/map/lapack2flamec/f2c/c/cunmlq.c @@ -186,8 +186,7 @@ int fla_cunmlq(char *side, char *trans, integer *m, integer *n, integer *k, comp { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -198,7 +197,7 @@ int fla_cunmlq(char *side, char *trans, integer *m, integer *n, integer *k, comp extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunml2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cunml2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -246,6 +245,7 @@ int fla_cunmlq(char *side, char *trans, integer *m, integer *n, integer *k, comp left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; + nb = 0; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { @@ -310,7 +310,7 @@ int fla_cunmlq(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMLQ", &i__1); + xerbla_("CUNMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/cunmql.c b/src/map/lapack2flamec/f2c/c/cunmql.c index 98c9fc423..2ba1e1f05 100644 --- a/src/map/lapack2flamec/f2c/c/cunmql.c +++ b/src/map/lapack2flamec/f2c/c/cunmql.c @@ -166,9 +166,10 @@ the routine */ int cunmql_(char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT - AOCL_DTL_SNPRINTF("cunmql inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc); - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + AOCL_DTL_SNPRINTF("cunmql inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc, *lwork); + + /* System generated locals */ + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -179,7 +180,7 @@ int cunmql_(char *side, char *trans, integer *m, integer *n, integer *k, complex extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunm2l_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cunm2l_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -215,6 +216,7 @@ int cunmql_(char *side, char *trans, integer *m, integer *n, integer *k, complex --work; /* Function Body */ *info = 0; + nb = 0; left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; @@ -282,7 +284,7 @@ int cunmql_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMQL", &i__1); + xerbla_("CUNMQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmqr.c b/src/map/lapack2flamec/f2c/c/cunmqr.c index 9a8576710..11d80657d 100644 --- a/src/map/lapack2flamec/f2c/c/cunmqr.c +++ b/src/map/lapack2flamec/f2c/c/cunmqr.c @@ -186,8 +186,7 @@ int cunmqr_(char *side, char *trans, integer *m, integer *n, integer *k, complex int fla_cunmqr(char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -198,7 +197,7 @@ int fla_cunmqr(char *side, char *trans, integer *m, integer *n, integer *k, comp extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cunm2r_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -301,7 +300,7 @@ int fla_cunmqr(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMQR", &i__1); + xerbla_("CUNMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/cunmr2.c b/src/map/lapack2flamec/f2c/c/cunmr2.c index b58cbd109..d292d2c5a 100644 --- a/src/map/lapack2flamec/f2c/c/cunmr2.c +++ b/src/map/lapack2flamec/f2c/c/cunmr2.c @@ -167,7 +167,7 @@ int cunmr2_(char *side, char *trans, integer *m, integer *n, integer *k, complex int clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -243,7 +243,7 @@ int cunmr2_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMR2", &i__1); + xerbla_("CUNMR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmr3.c b/src/map/lapack2flamec/f2c/c/cunmr3.c index 4fab68589..212fe41f7 100644 --- a/src/map/lapack2flamec/f2c/c/cunmr3.c +++ b/src/map/lapack2flamec/f2c/c/cunmr3.c @@ -182,7 +182,7 @@ int cunmr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer complex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int clarz_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex * ), xerbla_(char *, integer *); + int clarz_(char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -260,7 +260,7 @@ int cunmr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMR3", &i__1); + xerbla_("CUNMR3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmrq.c b/src/map/lapack2flamec/f2c/c/cunmrq.c index 7ef37214e..cc7982a1d 100644 --- a/src/map/lapack2flamec/f2c/c/cunmrq.c +++ b/src/map/lapack2flamec/f2c/c/cunmrq.c @@ -165,9 +165,10 @@ the routine */ int cunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT - AOCL_DTL_SNPRINTF("cunmrq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc); - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + AOCL_DTL_SNPRINTF("cunmrq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc, *lwork); + + /* System generated locals */ + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -178,7 +179,7 @@ int cunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, complex extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cunmr2_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -216,6 +217,7 @@ int cunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, complex --work; /* Function Body */ *info = 0; + nb = 0; left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; @@ -283,7 +285,7 @@ int cunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMRQ", &i__1); + xerbla_("CUNMRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmrz.c b/src/map/lapack2flamec/f2c/c/cunmrz.c index ff5e6e133..c4c6e2773 100644 --- a/src/map/lapack2flamec/f2c/c/cunmrz.c +++ b/src/map/lapack2flamec/f2c/c/cunmrz.c @@ -183,8 +183,10 @@ the routine */ int cunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer *l, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer * info) { AOCL_DTL_TRACE_LOG_INIT - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + AOCL_DTL_SNPRINTF(buffer, 256,"cunmrz inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", l %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *l, *lda, *ldc, *lwork); + + /* System generated locals */ + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -198,7 +200,7 @@ int cunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer int cunmr3_(char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarzb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), clarzt_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), clarzt_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *); logical notran; integer ldwork; char transt[1]; @@ -306,7 +308,7 @@ int cunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMRZ", &i__1); + xerbla_("CUNMRZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cunmtr.c b/src/map/lapack2flamec/f2c/c/cunmtr.c index 244c71005..c8593e16f 100644 --- a/src/map/lapack2flamec/f2c/c/cunmtr.c +++ b/src/map/lapack2flamec/f2c/c/cunmtr.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b CUNMTR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -170,8 +169,7 @@ the routine */ int cunmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, complex *a, integer *lda, complex *tau, complex *c__, integer *ldc, complex *work, integer *lwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3; + integer a_dim1, a_offset, c_dim1, c_offset, i__2, i__3; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -183,7 +181,7 @@ int cunmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, complex integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmql_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), cunmqr_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -303,7 +301,7 @@ int cunmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, complex if (*info != 0) { i__2 = -(*info); - xerbla_("CUNMTR", &i__2); + xerbla_("CUNMTR", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cupgtr.c b/src/map/lapack2flamec/f2c/c/cupgtr.c index eb13bfa82..a14c940d1 100644 --- a/src/map/lapack2flamec/f2c/c/cupgtr.c +++ b/src/map/lapack2flamec/f2c/c/cupgtr.c @@ -117,7 +117,7 @@ int cupgtr_(char *uplo, integer *n, complex *ap, complex * tau, complex *q, inte integer iinfo; logical upper; extern /* Subroutine */ - int cung2l_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cung2l_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), cung2r_( integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -164,7 +164,7 @@ int cupgtr_(char *uplo, integer *n, complex *ap, complex * tau, complex *q, inte if (*info != 0) { i__1 = -(*info); - xerbla_("CUPGTR", &i__1); + xerbla_("CUPGTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/cupmtr.c b/src/map/lapack2flamec/f2c/c/cupmtr.c index d0b426c9f..319292e80 100644 --- a/src/map/lapack2flamec/f2c/c/cupmtr.c +++ b/src/map/lapack2flamec/f2c/c/cupmtr.c @@ -164,7 +164,7 @@ int cupmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, complex extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -235,7 +235,7 @@ int cupmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, complex if (*info != 0) { i__1 = -(*info); - xerbla_("CUPMTR", &i__1); + xerbla_("CUPMTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dbbcsd.c b/src/map/lapack2flamec/f2c/c/dbbcsd.c index f0db97369..d3dd48158 100644 --- a/src/map/lapack2flamec/f2c/c/dbbcsd.c +++ b/src/map/lapack2flamec/f2c/c/dbbcsd.c @@ -363,7 +363,7 @@ int dbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, extern doublereal dlamch_(char *); doublereal sigma11, sigma21; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal thresh, tolmul; logical lquery; doublereal b11bulge, b12bulge; @@ -484,7 +484,7 @@ int dbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("DBBCSD", &i__1); + xerbla_("DBBCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dbdsdc.c b/src/map/lapack2flamec/f2c/c/dbdsdc.c index 5a22102ae..266bedc0f 100644 --- a/src/map/lapack2flamec/f2c/c/dbdsdc.c +++ b/src/map/lapack2flamec/f2c/c/dbdsdc.c @@ -228,7 +228,7 @@ int dbdsdc_(char *uplo, char *compq, integer *n, doublereal * d__, doublereal *e int dlasda_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer givcol; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); integer icompq; @@ -274,6 +274,15 @@ int dbdsdc_(char *uplo, char *compq, integer *n, doublereal * d__, doublereal *e /* Function Body */ *info = 0; iuplo = 0; + givnum = 0; + givcol = 0; + poles = 0; + difr = 0; + difl = 0; + ivt = 0; + is = 0; + ic = 0; + z__ = 0; if (lsame_(uplo, "U")) { iuplo = 1; @@ -321,7 +330,7 @@ int dbdsdc_(char *uplo, char *compq, integer *n, doublereal * d__, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DBDSDC", &i__1); + xerbla_("DBDSDC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dbdsqr.c b/src/map/lapack2flamec/f2c/c/dbdsqr.c index 5fb501051..810289cb9 100644 --- a/src/map/lapack2flamec/f2c/c/dbdsqr.c +++ b/src/map/lapack2flamec/f2c/c/dbdsqr.c @@ -277,7 +277,7 @@ int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, int dlasq1_(integer *, doublereal *, doublereal *, doublereal *, integer *), dlasv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal sminoa, thresh; logical rotate; doublereal tolmul; @@ -353,7 +353,7 @@ int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, if (*info != 0) { i__1 = -(*info); - xerbla_("DBDSQR", &i__1); + xerbla_("DBDSQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dbdsvdx.c b/src/map/lapack2flamec/f2c/c/dbdsvdx.c index 5108a0465..215ec4cd7 100644 --- a/src/map/lapack2flamec/f2c/c/dbdsvdx.c +++ b/src/map/lapack2flamec/f2c/c/dbdsvdx.c @@ -282,11 +282,12 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d integer iifail; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstol, thresh; integer iiwork; extern /* Subroutine */ - int dstevx_(); + int dstevx_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *w, doublereal *z__, integer *ldz, doublereal *work, integer *iwork, integer *ifail, integer *info); + doublereal *ev, *ev_arr; /* -- LAPACK driver routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -375,7 +376,7 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d if (*info != 0) { i__1 = -(*info); - xerbla_("DBDSVDX", &i__1); + xerbla_("DBDSVDX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -409,6 +410,16 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d AOCL_DTL_TRACE_LOG_EXIT return 0; } + /* Temporary Eigen Value buffer Allocation */ + ev_arr = (doublereal *) malloc(2 * *n * sizeof(doublereal)); + if (ev_arr == NULL) + { + *info = (*n << 1) + 1; + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } + ev = &ev_arr[-1]; + abstol = dlamch_("Safe Minimum") * 2; ulp = dlamch_("Precision"); eps = dlamch_("Epsilon"); @@ -522,9 +533,11 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d i__1 = *n - 1; dcopy_(&i__1, &e[1], &c__1, &work[ietgk + 1], &c__2); i__1 = *n << 1; - dstevx_("N", "V", &i__1, &work[idtgk], &work[ietgk], &vltgk, &vutgk, & iltgk, &iltgk, &abstol, ns, &s[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); + dstevx_("N", "V", &i__1, &work[idtgk], &work[ietgk], &vltgk, &vutgk, & iltgk, &iltgk, &abstol, ns, &ev[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); if (*ns == 0) { + /* De-allocate temporary Eigen Value buffer and return */ + free(ev_arr); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -559,8 +572,8 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d i__1 = *n - 1; dcopy_(&i__1, &e[1], &c__1, &work[ietgk + 1], &c__2); i__1 = *n << 1; - dstevx_("N", "I", &i__1, &work[idtgk], &work[ietgk], &vltgk, &vltgk, & iltgk, &iltgk, &abstol, ns, &s[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); - vltgk = s[1] - smax * 2. * ulp * *n; + dstevx_("N", "I", &i__1, &work[idtgk], &work[ietgk], &vltgk, &vltgk, & iltgk, &iltgk, &abstol, ns, &ev[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); + vltgk = ev[1] - smax * 2. * ulp * *n; /* WORK( IDTGK:IDTGK+2*N-1 ) = ZERO */ i__1 = *n << 1; for (j1 = 1; @@ -573,8 +586,8 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d i__1 = *n - 1; dcopy_(&i__1, &e[1], &c__1, &work[ietgk + 1], &c__2); i__1 = *n << 1; - dstevx_("N", "I", &i__1, &work[idtgk], &work[ietgk], &vutgk, &vutgk, & iutgk, &iutgk, &abstol, ns, &s[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); - vutgk = s[1] + smax * 2. * ulp * *n; + dstevx_("N", "I", &i__1, &work[idtgk], &work[ietgk], &vutgk, &vutgk, & iutgk, &iutgk, &abstol, ns, &ev[1], &z__[z_offset], ldz, &work[ itemp], &iwork[iiwork], &iwork[iifail], info); + vutgk = ev[1] + smax * 2. * ulp * *n; vutgk = fla_min(vutgk,0.); /* If VLTGK=VUTGK, DSTEVX returns an error message, */ /* so if needed we change VUTGK slightly. */ @@ -613,6 +626,7 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d ++j1) { s[j1] = 0.; + ev[j1] = 0.; } work[ietgk + (*n << 1) - 1] = 0.; /* WORK( IDTGK:IDTGK+2*N-1 ) = ZERO */ @@ -723,21 +737,32 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d /* Workspace needed by DSTEVX: */ /* WORK( ITEMP: ): 2*5*NTGK */ /* IWORK( 1: ): 2*6*NTGK */ - dstevx_(jobz, rngvx, &ntgk, &work[idtgk + isplt - 1], & work[ietgk + isplt - 1], &vltgk, &vutgk, &iltgk, & iutgk, &abstol, &nsl, &s[isbeg], &z__[irowz + icolz * z_dim1], ldz, &work[itemp], &iwork[iiwork], &iwork[iifail], info); + dstevx_(jobz, rngvx, &ntgk, &work[idtgk + isplt - 1], & work[ietgk + isplt - 1], &vltgk, &vutgk, &iltgk, & iutgk, &abstol, &nsl, &ev[isbeg], &z__[irowz + icolz * z_dim1], ldz, &work[itemp], &iwork[iiwork], &iwork[iifail], info); if (*info != 0) { + /* Assign Singular Values from temporary array to s */ + if (*info < 0) + { + i__3 = fla_min(*ns, *n); + for (j1 = 1; j1 <= i__3; ++j1) + { + s[j1] = ev[j1]; + } + } + /* De-allocate temporary Eigen Value buffer */ + free(ev_arr); /* Exit with the error code from DSTEVX. */ AOCL_DTL_TRACE_LOG_EXIT return 0; } /* EMIN = ABS( MAXVAL( S( ISBEG:ISBEG+NSL-1 ) ) ) */ - d1 = s[isbeg]; + d1 = ev[isbeg]; i__3 = nsl; for (j1 = 1; j1 <= i__3; ++j1) { - d1 = fla_max(d1, s[j1 - 1 + isbeg]); + d1 = fla_max(d1, ev[j1 - 1 + isbeg]); } emin = f2c_dabs(d1); if (nsl > 0 && wantz) @@ -785,6 +810,8 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d nrmu = dnrm2_(&nru, &z__[irowu + (icolz + i__) * z_dim1], &c__2); if (nrmu == 0.) { + /* De-allocate temporary Eigen Value buffer and return */ + free(ev_arr); *info = (*n << 1) + 1; AOCL_DTL_TRACE_LOG_EXIT return 0; @@ -817,6 +844,8 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d nrmv = dnrm2_(&nrv, &z__[irowv + (icolz + i__) * z_dim1], &c__2); if (nrmv == 0.) { + /* De-allocate temporary Eigen Value buffer and return */ + free(ev_arr); *info = (*n << 1) + 1; AOCL_DTL_TRACE_LOG_EXIT return 0; @@ -868,7 +897,7 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d i__ <= i__3; ++i__) { - s[isbeg + i__] = (d__1 = s[isbeg + i__], f2c_dabs(d__1)); + ev[isbeg + i__] = (d__1 = ev[isbeg + i__], f2c_dabs(d__1)); } /* Update pointers for TGK, S and Z. */ isbeg += nsl; @@ -929,22 +958,22 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d ++i__) { k = 1; - smin = s[1]; + smin = ev[1]; i__2 = *ns + 1 - i__; for (j = 2; j <= i__2; ++j) { - if (s[j] <= smin) + if (ev[j] <= smin) { k = j; - smin = s[j]; + smin = ev[j]; } } if (k != *ns + 1 - i__) { - s[k] = s[*ns + 1 - i__]; - s[*ns + 1 - i__] = smin; + ev[k] = ev[*ns + 1 - i__]; + ev[*ns + 1 - i__] = smin; if (wantz) { i__2 = *n << 1; @@ -964,7 +993,7 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d j1 <= i__1; ++j1) { - s[j1 + k] = 0.; + ev[j1 + k] = 0.; } /* IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO */ if (wantz) @@ -986,6 +1015,11 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d *ns = k; } } + /* Assign Singular Values from temporary array to s */ + for (j1 = 1; j1 <= *ns; ++j1) + { + s[j1] = ev[j1]; + } /* Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). */ /* If B is a lower diagonal, swap U and V. */ if (wantz) @@ -1009,6 +1043,8 @@ int dbdsvdx_(char *uplo, char *jobz, char *range, integer *n, doublereal *d__, d } } } + /* De-allocate temporary Eigen Value buffer */ + free(ev_arr); AOCL_DTL_TRACE_LOG_EXIT return 0; /* End of DBDSVDX */ diff --git a/src/map/lapack2flamec/f2c/c/ddisna.c b/src/map/lapack2flamec/f2c/c/ddisna.c index e90604c82..6a4496c71 100644 --- a/src/map/lapack2flamec/f2c/c/ddisna.c +++ b/src/map/lapack2flamec/f2c/c/ddisna.c @@ -122,7 +122,7 @@ int ddisna_(char *job, integer *m, integer *n, doublereal * d__, doublereal *sep extern doublereal dlamch_(char *); doublereal oldgap, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal newgap, thresh; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -212,7 +212,7 @@ int ddisna_(char *job, integer *m, integer *n, doublereal * d__, doublereal *sep if (*info != 0) { i__1 = -(*info); - xerbla_("DDISNA", &i__1); + xerbla_("DDISNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbbrd.c b/src/map/lapack2flamec/f2c/c/dgbbrd.c index 523142792..5da6c6dc4 100644 --- a/src/map/lapack2flamec/f2c/c/dgbbrd.c +++ b/src/map/lapack2flamec/f2c/c/dgbbrd.c @@ -201,7 +201,7 @@ int dgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ integer minmn; logical wantq; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *), dlargv_( integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlartv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlargv_( integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlartv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical wantpt; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -290,7 +290,7 @@ int dgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ if (*info != 0) { i__1 = -(*info); - xerbla_("DGBBRD", &i__1); + xerbla_("DGBBRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbcon.c b/src/map/lapack2flamec/f2c/c/dgbcon.c index a97870b23..1d1819caa 100644 --- a/src/map/lapack2flamec/f2c/c/dgbcon.c +++ b/src/map/lapack2flamec/f2c/c/dgbcon.c @@ -159,7 +159,7 @@ int dgbcon_(char *norm, integer *n, integer *kl, integer *ku, doublereal *ab, in extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlatbs_(char *, char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlatbs_(char *, char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; logical onenrm; char normin[1]; @@ -224,7 +224,7 @@ int dgbcon_(char *norm, integer *n, integer *kl, integer *ku, doublereal *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGBCON", &i__1); + xerbla_("DGBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbequ.c b/src/map/lapack2flamec/f2c/c/dgbequ.c index b22859237..9b2e70603 100644 --- a/src/map/lapack2flamec/f2c/c/dgbequ.c +++ b/src/map/lapack2flamec/f2c/c/dgbequ.c @@ -150,7 +150,7 @@ int dgbequ_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in doublereal rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -204,7 +204,7 @@ int dgbequ_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGBEQU", &i__1); + xerbla_("DGBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbequb.c b/src/map/lapack2flamec/f2c/c/dgbequb.c index 7da68fd3d..2d8b323ca 100644 --- a/src/map/lapack2flamec/f2c/c/dgbequb.c +++ b/src/map/lapack2flamec/f2c/c/dgbequb.c @@ -159,7 +159,7 @@ int dgbequb_(integer *m, integer *n, integer *kl, integer * ku, doublereal *ab, doublereal radix, rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -213,7 +213,7 @@ int dgbequb_(integer *m, integer *n, integer *kl, integer * ku, doublereal *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("DGBEQUB", &i__1); + xerbla_("DGBEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbrfs.c b/src/map/lapack2flamec/f2c/c/dgbrfs.c index 8d4b463b2..71851441b 100644 --- a/src/map/lapack2flamec/f2c/c/dgbrfs.c +++ b/src/map/lapack2flamec/f2c/c/dgbrfs.c @@ -221,7 +221,7 @@ int dgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dgbtrs_( char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgbtrs_( char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); logical notran; char transt[1]; doublereal lstres; @@ -308,7 +308,7 @@ int dgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGBRFS", &i__1); + xerbla_("DGBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbrfsx.c b/src/map/lapack2flamec/f2c/c/dgbrfsx.c index d685e2812..dcb149d62 100644 --- a/src/map/lapack2flamec/f2c/c/dgbrfsx.c +++ b/src/map/lapack2flamec/f2c/c/dgbrfsx.c @@ -463,7 +463,7 @@ int dgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in doublereal anorm; extern doublereal dlangb_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int dgbcon_(char *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgbcon_(char *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -624,7 +624,7 @@ int dgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGBRFSX", &i__1); + xerbla_("DGBRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbsv.c b/src/map/lapack2flamec/f2c/c/dgbsv.c index 3072e8d85..6ab2ae8b7 100644 --- a/src/map/lapack2flamec/f2c/c/dgbsv.c +++ b/src/map/lapack2flamec/f2c/c/dgbsv.c @@ -159,7 +159,7 @@ int dgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, doublereal *ab, integer ab_dim1, ab_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *), dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -212,7 +212,7 @@ int dgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, doublereal *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("DGBSV ", &i__1); + xerbla_("DGBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbsvx.c b/src/map/lapack2flamec/f2c/c/dgbsvx.c index f67ec7aa1..4e6c041b9 100644 --- a/src/map/lapack2flamec/f2c/c/dgbsvx.c +++ b/src/map/lapack2flamec/f2c/c/dgbsvx.c @@ -387,7 +387,7 @@ int dgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ int dgbequ_(integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dgbrfs_( char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -443,6 +443,8 @@ int dgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -574,7 +576,7 @@ int dgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ if (*info != 0) { i__1 = -(*info); - xerbla_("DGBSVX", &i__1); + xerbla_("DGBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbsvxx.c b/src/map/lapack2flamec/f2c/c/dgbsvxx.c index 659c35a0e..a79d0a008 100644 --- a/src/map/lapack2flamec/f2c/c/dgbsvxx.c +++ b/src/map/lapack2flamec/f2c/c/dgbsvxx.c @@ -578,7 +578,7 @@ int dgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int int dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -776,7 +776,7 @@ int dgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int if (*info != 0) { i__1 = -(*info); - xerbla_("DGBSVXX", &i__1); + xerbla_("DGBSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgbtf2.c b/src/map/lapack2flamec/f2c/c/dgbtf2.c index 0431d4a53..1dfa51e54 100644 --- a/src/map/lapack2flamec/f2c/c/dgbtf2.c +++ b/src/map/lapack2flamec/f2c/c/dgbtf2.c @@ -150,7 +150,7 @@ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dscal_(integer *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -209,7 +209,7 @@ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGBTF2", &i__1); + xerbla_("DGBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -220,7 +220,7 @@ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -255,8 +255,8 @@ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ if(j%32==0 || j==i__1){ - step_count=j; - AOCL_FLA_PROGRESS_FUNC_PTR("DGBTF2",6,&step_count,&thread_id,&total_threads); + progress_step_count=j; + AOCL_FLA_PROGRESS_FUNC_PTR("DGBTF2",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } } #endif diff --git a/src/map/lapack2flamec/f2c/c/dgbtrf.c b/src/map/lapack2flamec/f2c/c/dgbtrf.c index 4915645e9..39db8ed0a 100644 --- a/src/map/lapack2flamec/f2c/c/dgbtrf.c +++ b/src/map/lapack2flamec/f2c/c/dgbtrf.c @@ -159,7 +159,7 @@ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgbtf2_( integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); @@ -223,7 +223,7 @@ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGBTRF", &i__1); + xerbla_("DGBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -234,7 +234,7 @@ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -318,8 +318,8 @@ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublereal *ab, in jb = fla_min(i__3,i__4); #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("DGBTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("DGBTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/map/lapack2flamec/f2c/c/dgbtrs.c b/src/map/lapack2flamec/f2c/c/dgbtrs.c index be920f6d2..23758f645 100644 --- a/src/map/lapack2flamec/f2c/c/dgbtrs.c +++ b/src/map/lapack2flamec/f2c/c/dgbtrs.c @@ -143,7 +143,7 @@ int dgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtbsv_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); logical lnoti; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -208,7 +208,7 @@ int dgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGBTRS", &i__1); + xerbla_("DGBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgebak.c b/src/map/lapack2flamec/f2c/c/dgebak.c index 777661ad1..c284862f1 100644 --- a/src/map/lapack2flamec/f2c/c/dgebak.c +++ b/src/map/lapack2flamec/f2c/c/dgebak.c @@ -137,7 +137,7 @@ int dgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical leftv; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -200,7 +200,7 @@ int dgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DGEBAK", &i__1); + xerbla_("DGEBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgebal.c b/src/map/lapack2flamec/f2c/c/dgebal.c index f4f341668..d6e34c54d 100644 --- a/src/map/lapack2flamec/f2c/c/dgebal.c +++ b/src/map/lapack2flamec/f2c/c/dgebal.c @@ -175,7 +175,7 @@ int dgebal_(char *job, integer *n, doublereal *a, integer * lda, integer *ilo, i extern integer idamax_(integer *, doublereal *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noconv; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -220,7 +220,7 @@ int dgebal_(char *job, integer *n, doublereal *a, integer * lda, integer *ilo, i if (*info != 0) { i__1 = -(*info); - xerbla_("DGEBAL", &i__1); + xerbla_("DGEBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -389,7 +389,7 @@ int dgebal_(char *job, integer *n, doublereal *a, integer * lda, integer *ilo, i /* Exit if NaN to avoid infinite loop */ *info = -3; i__2 = -(*info); - xerbla_("DGEBAL", &i__2); + xerbla_("DGEBAL", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgecon.c b/src/map/lapack2flamec/f2c/c/dgecon.c index 743695881..83f455388 100644 --- a/src/map/lapack2flamec/f2c/c/dgecon.c +++ b/src/map/lapack2flamec/f2c/c/dgecon.c @@ -132,7 +132,7 @@ int dgecon_(char *norm, integer *n, doublereal *a, integer * lda, doublereal *an extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dlatrs_(char *, char *, char *, char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); @@ -190,7 +190,7 @@ int dgecon_(char *norm, integer *n, doublereal *a, integer * lda, doublereal *an if (*info != 0) { i__1 = -(*info); - xerbla_("DGECON", &i__1); + xerbla_("DGECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeequ.c b/src/map/lapack2flamec/f2c/c/dgeequ.c index 320a4613c..73ce7c794 100644 --- a/src/map/lapack2flamec/f2c/c/dgeequ.c +++ b/src/map/lapack2flamec/f2c/c/dgeequ.c @@ -136,7 +136,7 @@ int dgeequ_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *r_ doublereal rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -182,7 +182,7 @@ int dgeequ_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *r_ if (*info != 0) { i__1 = -(*info); - xerbla_("DGEEQU", &i__1); + xerbla_("DGEEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeequb.c b/src/map/lapack2flamec/f2c/c/dgeequb.c index ef5c6aa1d..d2faca935 100644 --- a/src/map/lapack2flamec/f2c/c/dgeequb.c +++ b/src/map/lapack2flamec/f2c/c/dgeequb.c @@ -145,7 +145,7 @@ int dgeequb_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *r doublereal radix, rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -191,7 +191,7 @@ int dgeequb_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *r if (*info != 0) { i__1 = -(*info); - xerbla_("DGEEQUB", &i__1); + xerbla_("DGEEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgees.c b/src/map/lapack2flamec/f2c/c/dgees.c index d88f0a7ca..8cd4f0c02 100644 --- a/src/map/lapack2flamec/f2c/c/dgees.c +++ b/src/map/lapack2flamec/f2c/c/dgees.c @@ -214,7 +214,7 @@ if */ /* > \ingroup doubleGEeigen */ /* ===================================================================== */ /* Subroutine */ -int dgees_(char *jobvs, char *sort, L_fp select, integer *n, doublereal *a, integer *lda, integer *sdim, doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs, doublereal *work, integer *lwork, logical *bwork, integer *info) +int dgees_(char *jobvs, char *sort, L_fpd2 select, integer *n, doublereal *a, integer *lda, integer *sdim, doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs, doublereal *work, integer *lwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgees inputs: jobvs %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldvs %" FLA_IS ", lwork %" FLA_IS "",*jobvs, *sort, *n, *lda, *ldvs, *lwork); @@ -241,7 +241,7 @@ int dgees_(char *jobvs, char *sort, L_fp select, integer *n, doublereal *a, inte doublereal cscale; extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; extern /* Subroutine */ @@ -362,7 +362,7 @@ int dgees_(char *jobvs, char *sort, L_fp select, integer *n, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DGEES ", &i__1); + xerbla_("DGEES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeesx.c b/src/map/lapack2flamec/f2c/c/dgeesx.c index 185d9005f..a7764f90e 100644 --- a/src/map/lapack2flamec/f2c/c/dgeesx.c +++ b/src/map/lapack2flamec/f2c/c/dgeesx.c @@ -284,7 +284,7 @@ if */ /* > \ingroup doubleGEeigen */ /* ===================================================================== */ /* Subroutine */ -int dgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doublereal *a, integer *lda, integer *sdim, doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs, doublereal *rconde, doublereal *rcondv, doublereal *work, integer * lwork, integer *iwork, integer *liwork, logical *bwork, integer *info) +int dgeesx_(char *jobvs, char *sort, L_fpd2 select, char * sense, integer *n, doublereal *a, integer *lda, integer *sdim, doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs, doublereal *rconde, doublereal *rcondv, doublereal *work, integer * lwork, integer *iwork, integer *liwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgeesx inputs: jobvs %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", ldvs %" FLA_IS ", lwork %" FLA_IS "",*jobvs, *sort, *sense, *n, *lda, *ldvs, *lwork); @@ -310,7 +310,7 @@ int dgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub doublereal cscale; extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; extern /* Subroutine */ @@ -363,6 +363,7 @@ int dgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub --bwork; /* Function Body */ *info = 0; + maxwrk = 0; wantvs = lsame_(jobvs, "V"); wantst = lsame_(sort, "S"); wantsn = lsame_(sense, "N"); @@ -466,7 +467,7 @@ int dgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DGEESX", &i__1); + xerbla_("DGEESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeev.c b/src/map/lapack2flamec/f2c/c/dgeev.c index ae9bd64e9..199e3ab84 100644 --- a/src/map/lapack2flamec/f2c/c/dgeev.c +++ b/src/map/lapack2flamec/f2c/c/dgeev.c @@ -223,7 +223,7 @@ int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical select[1]; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; @@ -392,7 +392,7 @@ int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGEEV ", &i__1); + xerbla_("DGEEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeevx.c b/src/map/lapack2flamec/f2c/c/dgeevx.c index 25a59c57d..0c37ce31d 100644 --- a/src/map/lapack2flamec/f2c/c/dgeevx.c +++ b/src/map/lapack2flamec/f2c/c/dgeevx.c @@ -340,7 +340,7 @@ int dgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical select[1]; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; @@ -543,7 +543,7 @@ int dgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGEEVX", &i__1); + xerbla_("DGEEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgegs.c b/src/map/lapack2flamec/f2c/c/dgegs.c index 6412dfe45..6bfa988f7 100644 --- a/src/map/lapack2flamec/f2c/c/dgegs.c +++ b/src/map/lapack2flamec/f2c/c/dgegs.c @@ -246,7 +246,7 @@ int dgegs_(char *jobvsl, char *jobvsr, integer *n, doublereal *a, integer *lda, int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; extern /* Subroutine */ @@ -385,7 +385,7 @@ int dgegs_(char *jobvsl, char *jobvsr, integer *n, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEGS ", &i__1); + xerbla_("DGEGS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgegv.c b/src/map/lapack2flamec/f2c/c/dgegv.c index 1d7a24c89..20c3634d7 100644 --- a/src/map/lapack2flamec/f2c/c/dgegv.c +++ b/src/map/lapack2flamec/f2c/c/dgegv.c @@ -336,7 +336,7 @@ int dgegv_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d char chtemp[1]; logical ldumma[1]; extern /* Subroutine */ - int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dtgevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dtgevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijobvl, iright; logical ilimit; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); @@ -478,7 +478,7 @@ int dgegv_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGEGV ", &i__1); + xerbla_("DGEGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgehd2.c b/src/map/lapack2flamec/f2c/c/dgehd2.c index b43626ec8..18b47f084 100644 --- a/src/map/lapack2flamec/f2c/c/dgehd2.c +++ b/src/map/lapack2flamec/f2c/c/dgehd2.c @@ -149,7 +149,7 @@ int dgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, integer i__; doublereal aii; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -196,7 +196,7 @@ int dgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEHD2", &i__1); + xerbla_("DGEHD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgehrd.c b/src/map/lapack2flamec/f2c/c/dgehrd.c index 4ed2e8947..bc163a35a 100644 --- a/src/map/lapack2flamec/f2c/c/dgehrd.c +++ b/src/map/lapack2flamec/f2c/c/dgehrd.c @@ -179,7 +179,7 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nbmin, iinfo; extern /* Subroutine */ - int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), daxpy_( integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgehd2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlahr2_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), daxpy_( integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgehd2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlahr2_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -212,6 +212,7 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, --work; /* Function Body */ *info = 0; + nx = 0; lquery = *lwork == -1; if (*n < 0) { @@ -246,7 +247,7 @@ int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEHRD", &i__1); + xerbla_("DGEHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgejsv.c b/src/map/lapack2flamec/f2c/c/dgejsv.c index 2b71e4670..fd022f0b2 100644 --- a/src/map/lapack2flamec/f2c/c/dgejsv.c +++ b/src/map/lapack2flamec/f2c/c/dgejsv.c @@ -520,7 +520,7 @@ int dgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); doublereal aatmax; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noscal; extern /* Subroutine */ int dpocon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgesvj_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); @@ -663,7 +663,7 @@ int dgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { /* #:( */ i__1 = -(*info); - xerbla_("DGEJSV", &i__1); + xerbla_("DGEJSV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -723,7 +723,7 @@ int dgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { *info = -9; i__2 = -(*info); - xerbla_("DGEJSV", &i__2); + xerbla_("DGEJSV", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelq.c b/src/map/lapack2flamec/f2c/c/dgelq.c index bcaabc179..25b021957 100644 --- a/src/map/lapack2flamec/f2c/c/dgelq.c +++ b/src/map/lapack2flamec/f2c/c/dgelq.c @@ -178,7 +178,7 @@ int dgelq_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t, logical mint, minw; integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dgelqt_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -346,7 +346,7 @@ int dgelq_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQ", &i__1); + xerbla_("DGELQ", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelqt.c b/src/map/lapack2flamec/f2c/c/dgelqt.c index b194540a2..cb0e95562 100644 --- a/src/map/lapack2flamec/f2c/c/dgelqt.c +++ b/src/map/lapack2flamec/f2c/c/dgelqt.c @@ -135,7 +135,7 @@ int dgelqt_(integer *m, integer *n, integer *mb, doublereal * a, integer *lda, d /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dgelqt3_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgelqt3_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int dgelqt_(integer *m, integer *n, integer *mb, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQT", &i__1); + xerbla_("DGELQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelqt3.c b/src/map/lapack2flamec/f2c/c/dgelqt3.c index 883f5c545..372447837 100644 --- a/src/map/lapack2flamec/f2c/c/dgelqt3.c +++ b/src/map/lapack2flamec/f2c/c/dgelqt3.c @@ -134,7 +134,7 @@ int dgelqt3_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer iinfo; extern /* Subroutine */ - int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -179,7 +179,7 @@ int dgelqt3_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t if (*info != 0) { i__1 = -(*info); - xerbla_("DGELQT3", &i__1); + xerbla_("DGELQT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgels.c b/src/map/lapack2flamec/f2c/c/dgels.c index c450e97e7..ff7989060 100644 --- a/src/map/lapack2flamec/f2c/c/dgels.c +++ b/src/map/lapack2flamec/f2c/c/dgels.c @@ -203,7 +203,7 @@ int dgels_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, i int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; doublereal bignum; @@ -340,7 +340,7 @@ int dgels_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DGELS ", &i__1); + xerbla_("DGELS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelss.c b/src/map/lapack2flamec/f2c/c/dgelss.c index 149f1c47d..04f03ce12 100644 --- a/src/map/lapack2flamec/f2c/c/dgelss.c +++ b/src/map/lapack2flamec/f2c/c/dgelss.c @@ -194,7 +194,7 @@ int dgelss_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); integer bdspac; extern /* Subroutine */ - int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); + int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); doublereal bignum; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ @@ -242,6 +242,7 @@ int dgelss_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, minmn = fla_min(*m,*n); maxmn = fla_max(*m,*n); lquery = *lwork == -1; + mnthr = 0; if (*m < 0) { *info = -1; @@ -445,7 +446,7 @@ int dgelss_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELSS", &i__1); + xerbla_("DGELSS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelst.c b/src/map/lapack2flamec/f2c/c/dgelst.c index 32fa06490..4a7632cc2 100644 --- a/src/map/lapack2flamec/f2c/c/dgelst.c +++ b/src/map/lapack2flamec/f2c/c/dgelst.c @@ -214,7 +214,7 @@ int dgelst_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; doublereal bignum; @@ -317,7 +317,7 @@ int dgelst_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELST ", &i__1); + xerbla_("DGELST ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelsx.c b/src/map/lapack2flamec/f2c/c/dgelsx.c index b05ec3a97..c787158c2 100644 --- a/src/map/lapack2flamec/f2c/c/dgelsx.c +++ b/src/map/lapack2flamec/f2c/c/dgelsx.c @@ -188,7 +188,7 @@ int dgelsx_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlaic1_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dorm2r_( char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqpf_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqpf_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dlatzm_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *); @@ -258,7 +258,7 @@ int dgelsx_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELSX", &i__1); + xerbla_("DGELSX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgelsy.c b/src/map/lapack2flamec/f2c/c/dgelsy.c index 3629a79f2..b553354a9 100644 --- a/src/map/lapack2flamec/f2c/c/dgelsy.c +++ b/src/map/lapack2flamec/f2c/c/dgelsy.c @@ -221,7 +221,7 @@ int dgelsy_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, int dgeqp3_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, integer *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; integer lwkmin; @@ -333,7 +333,7 @@ int dgelsy_(integer *m, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGELSY", &i__1); + xerbla_("DGELSY", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgemlq.c b/src/map/lapack2flamec/f2c/c/dgemlq.c index 463113bff..023f86726 100644 --- a/src/map/lapack2flamec/f2c/c/dgemlq.c +++ b/src/map/lapack2flamec/f2c/c/dgemlq.c @@ -175,9 +175,8 @@ int dgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int dgemlqt_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -228,21 +227,6 @@ int dgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler lw = *m * mb; mn = *n; } - if (nb > *k && mn > *k) - { - if ((mn - *k) % (nb - *k) == 0) - { - nblcks = (mn - *k) / (nb - *k); - } - else - { - nblcks = (mn - *k) / (nb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -287,7 +271,7 @@ int dgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DGEMLQ", &i__1); + xerbla_("DGEMLQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgemlqt.c b/src/map/lapack2flamec/f2c/c/dgemlqt.c index 94e7175f5..be6e574a0 100644 --- a/src/map/lapack2flamec/f2c/c/dgemlqt.c +++ b/src/map/lapack2flamec/f2c/c/dgemlqt.c @@ -167,7 +167,7 @@ int dgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine -- */ @@ -255,7 +255,7 @@ int dgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DGEMLQT", &i__1); + xerbla_("DGEMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgemqr.c b/src/map/lapack2flamec/f2c/c/dgemqr.c index 1b750f4b0..bdea214f3 100644 --- a/src/map/lapack2flamec/f2c/c/dgemqr.c +++ b/src/map/lapack2flamec/f2c/c/dgemqr.c @@ -177,9 +177,8 @@ int dgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doubler logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int dgemqrt_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -230,21 +229,6 @@ int dgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doubler lw = mb * nb; mn = *n; } - if (mb > *k && mn > *k) - { - if ((mn - *k) % (mb - *k) == 0) - { - nblcks = (mn - *k) / (mb - *k); - } - else - { - nblcks = (mn - *k) / (mb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -289,7 +273,7 @@ int dgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DGEMQR", &i__1); + xerbla_("DGEMQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgemqrt.c b/src/map/lapack2flamec/f2c/c/dgemqrt.c index 111184c1a..84fde256c 100644 --- a/src/map/lapack2flamec/f2c/c/dgemqrt.c +++ b/src/map/lapack2flamec/f2c/c/dgemqrt.c @@ -169,7 +169,7 @@ int dgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -258,7 +258,7 @@ int dgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DGEMQRT", &i__1); + xerbla_("DGEMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeql2.c b/src/map/lapack2flamec/f2c/c/dgeql2.c index 6acab0775..add02dde2 100644 --- a/src/map/lapack2flamec/f2c/c/dgeql2.c +++ b/src/map/lapack2flamec/f2c/c/dgeql2.c @@ -124,7 +124,7 @@ int dgeql2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta integer i__, k; doublereal aii; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int dgeql2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQL2", &i__1); + xerbla_("DGEQL2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeqlf.c b/src/map/lapack2flamec/f2c/c/dgeqlf.c index 4e4b88af7..b2b7f5f91 100644 --- a/src/map/lapack2flamec/f2c/c/dgeqlf.c +++ b/src/map/lapack2flamec/f2c/c/dgeqlf.c @@ -142,7 +142,7 @@ int dgeqlf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int dgeql2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dgeql2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -173,6 +173,7 @@ int dgeqlf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -207,7 +208,7 @@ int dgeqlf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQLF", &i__1); + xerbla_("DGEQLF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeqr.c b/src/map/lapack2flamec/f2c/c/dgeqr.c index 453697ddd..a461822e7 100644 --- a/src/map/lapack2flamec/f2c/c/dgeqr.c +++ b/src/map/lapack2flamec/f2c/c/dgeqr.c @@ -180,7 +180,7 @@ int dgeqr_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t, logical mint, minw; integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dgeqrt_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -348,7 +348,7 @@ int dgeqr_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t, if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQR", &i__1); + xerbla_("DGEQR", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeqrt.c b/src/map/lapack2flamec/f2c/c/dgeqrt.c index b0ea47c36..00bf54707 100644 --- a/src/map/lapack2flamec/f2c/c/dgeqrt.c +++ b/src/map/lapack2flamec/f2c/c/dgeqrt.c @@ -137,7 +137,7 @@ int dgeqrt_(integer *m, integer *n, integer *nb, doublereal * a, integer *lda, d /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dgeqrt2_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dgeqrt3_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgeqrt2_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dgeqrt3_(integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -187,7 +187,7 @@ int dgeqrt_(integer *m, integer *n, integer *nb, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRT", &i__1); + xerbla_("DGEQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeqrt2.c b/src/map/lapack2flamec/f2c/c/dgeqrt2.c index e1d8d3cf3..b5a2b864b 100644 --- a/src/map/lapack2flamec/f2c/c/dgeqrt2.c +++ b/src/map/lapack2flamec/f2c/c/dgeqrt2.c @@ -131,7 +131,7 @@ int dgeqrt2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal alpha; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int dgeqrt2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRT2", &i__1); + xerbla_("DGEQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgeqrt3.c b/src/map/lapack2flamec/f2c/c/dgeqrt3.c index afe357027..e0d0ef916 100644 --- a/src/map/lapack2flamec/f2c/c/dgeqrt3.c +++ b/src/map/lapack2flamec/f2c/c/dgeqrt3.c @@ -136,7 +136,7 @@ int dgeqrt3_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer iinfo; extern /* Subroutine */ - int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -181,7 +181,7 @@ int dgeqrt3_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *t if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRT3", &i__1); + xerbla_("DGEQRT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgerfs.c b/src/map/lapack2flamec/f2c/c/dgerfs.c index 45ff78af5..b233ddfb9 100644 --- a/src/map/lapack2flamec/f2c/c/dgerfs.c +++ b/src/map/lapack2flamec/f2c/c/dgerfs.c @@ -200,7 +200,7 @@ int dgerfs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dgetrs_( char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgetrs_( char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); logical notran; char transt[1]; doublereal lstres; @@ -279,7 +279,7 @@ int dgerfs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DGERFS", &i__1); + xerbla_("DGERFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgerfsx.c b/src/map/lapack2flamec/f2c/c/dgerfsx.c index 3d25e47c2..2da256c9d 100644 --- a/src/map/lapack2flamec/f2c/c/dgerfsx.c +++ b/src/map/lapack2flamec/f2c/c/dgerfsx.c @@ -436,7 +436,7 @@ int dgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, doublereal *a doublereal anorm; extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dgecon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgecon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -589,7 +589,7 @@ int dgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DGERFSX", &i__1); + xerbla_("DGERFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgerq2.c b/src/map/lapack2flamec/f2c/c/dgerq2.c index f2bf6c72a..192a529f3 100644 --- a/src/map/lapack2flamec/f2c/c/dgerq2.c +++ b/src/map/lapack2flamec/f2c/c/dgerq2.c @@ -122,7 +122,7 @@ int dgerq2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta integer i__, k; doublereal aii; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -165,7 +165,7 @@ int dgerq2_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DGERQ2", &i__1); + xerbla_("DGERQ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgerqf.c b/src/map/lapack2flamec/f2c/c/dgerqf.c index 3a0673bc0..efca11434 100644 --- a/src/map/lapack2flamec/f2c/c/dgerqf.c +++ b/src/map/lapack2flamec/f2c/c/dgerqf.c @@ -142,7 +142,7 @@ int dgerqf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int dgerq2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dgerq2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -172,6 +172,7 @@ int dgerqf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -209,7 +210,7 @@ int dgerqf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DGERQF", &i__1); + xerbla_("DGERQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesv.c b/src/map/lapack2flamec/f2c/c/dgesv.c index 468f8d483..fed2c6ebd 100644 --- a/src/map/lapack2flamec/f2c/c/dgesv.c +++ b/src/map/lapack2flamec/f2c/c/dgesv.c @@ -118,7 +118,7 @@ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DGESV ", &i__1); + xerbla_("DGESV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesvdq.c b/src/map/lapack2flamec/f2c/c/dgesvdq.c index 496916609..186cc5afe 100644 --- a/src/map/lapack2flamec/f2c/c/dgesvdq.c +++ b/src/map/lapack2flamec/f2c/c/dgesvdq.c @@ -459,7 +459,7 @@ int dgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer extern integer idamax_(integer *, doublereal *, integer *); doublereal sconda; extern /* Subroutine */ - int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgesvd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *), dpocon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *), dormlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); + int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgesvd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *), dpocon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *), dormlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); integer minwrk; logical rtrans; doublereal rdummy[1]; @@ -516,6 +516,10 @@ int dgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer acclh = lsame_(joba, "H") || conda; rowprm = lsame_(jobp, "P"); rtrans = lsame_(jobr, "T"); + sconda = 0.; + lworq = 0; + lwrk_dormqr__ = 0; + lwrk_dgeqp3__ = 0; if (rowprm) { if (conda) @@ -924,7 +928,7 @@ int dgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DGESVDQ", &i__1); + xerbla_("DGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -967,7 +971,7 @@ int dgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__2 = -(*info); - xerbla_("DGESVDQ", &i__2); + xerbla_("DGESVDQ", &i__2, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -1060,7 +1064,7 @@ int dgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__1 = -(*info); - xerbla_("DGESVDQ", &i__1); + xerbla_("DGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesvdx.c b/src/map/lapack2flamec/f2c/c/dgesvdx.c index dfc8d07e1..aec751daa 100644 --- a/src/map/lapack2flamec/f2c/c/dgesvdx.c +++ b/src/map/lapack2flamec/f2c/c/dgesvdx.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c__1 = 1; static integer c_n1 = -1; static doublereal c_b109 = 0.; @@ -270,8 +269,7 @@ int dgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgesvdx inputs: jobu %c, jobvt %c, range %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", il %" FLA_IS ", iu %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS ", lwork %" FLA_IS "",*jobu, *jobvt, *range, *m, *n, *lda, *il, *iu, *ldu, *ldvt, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -297,9 +295,9 @@ int dgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub int dgebrd_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); - doublereal bignum, abstol; + doublereal bignum; extern /* Subroutine */ int dormbr_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); char rngtgk[1]; @@ -349,11 +347,11 @@ int dgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub /* Function Body */ *ns = 0; *info = 0; - abstol = dlamch_("S") * 2; lquery = *lwork == -1; minmn = fla_min(*m,*n); wantu = lsame_(jobu, "V"); wantvt = lsame_(jobvt, "V"); + mnthr = 0; if (wantu || wantvt) { *(unsigned char *)jobz = 'V'; @@ -561,7 +559,7 @@ int dgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub if (*info != 0) { i__2 = -(*info); - xerbla_("DGESVDX", &i__2); + xerbla_("DGESVDX", &i__2, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesvj.c b/src/map/lapack2flamec/f2c/c/dgesvj.c index 8d7ea4a76..f5714a8b0 100644 --- a/src/map/lapack2flamec/f2c/c/dgesvj.c +++ b/src/map/lapack2flamec/f2c/c/dgesvj.c @@ -364,7 +364,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere doublereal temp1; extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *, integer *); - doublereal large, apoaq, aqoap; + doublereal apoaq, aqoap; extern logical lsame_(char *, char *); doublereal theta, small_val, sfmin; logical lsvec; @@ -388,7 +388,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband, blskip; doublereal mxaapq; extern /* Subroutine */ @@ -497,7 +497,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere if (*info != 0) { i__1 = -(*info); - xerbla_("DGESVJ", &i__1); + xerbla_("DGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -540,7 +540,6 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere big = dlamch_("Overflow"); /* BIG = ONE / SFMIN */ rootbig = 1. / rootsfmin; - large = big / sqrt((doublereal) (*m * *n)); bigtheta = 1. / rooteps; tol = ctol * epsln; roottol = sqrt(tol); @@ -548,7 +547,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere { *info = -4; i__1 = -(*info); - xerbla_("DGESVJ", &i__1); + xerbla_("DGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -590,7 +589,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere { *info = -6; i__2 = -(*info); - xerbla_("DGESVJ", &i__2); + xerbla_("DGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -634,7 +633,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere { *info = -6; i__2 = -(*info); - xerbla_("DGESVJ", &i__2); + xerbla_("DGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -678,7 +677,7 @@ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doublere { *info = -6; i__2 = -(*info); - xerbla_("DGESVJ", &i__2); + xerbla_("DGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesvx.c b/src/map/lapack2flamec/f2c/c/dgesvx.c index 1420af1df..089a649ea 100644 --- a/src/map/lapack2flamec/f2c/c/dgesvx.c +++ b/src/map/lapack2flamec/f2c/c/dgesvx.c @@ -360,7 +360,7 @@ int dgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *a, doublereal colcnd; logical nofact; extern /* Subroutine */ - int dgeequ_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dgerfs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgeequ_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dgerfs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlantr_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *); integer infequ; @@ -417,6 +417,8 @@ int dgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *a, nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -540,7 +542,7 @@ int dgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DGESVX", &i__1); + xerbla_("DGESVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgesvxx.c b/src/map/lapack2flamec/f2c/c/dgesvxx.c index a28214c80..ceae88490 100644 --- a/src/map/lapack2flamec/f2c/c/dgesvxx.c +++ b/src/map/lapack2flamec/f2c/c/dgesvxx.c @@ -556,7 +556,7 @@ int dgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *a, doublereal colcnd; logical nofact; extern /* Subroutine */ - int dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer infequ; logical colequ; @@ -746,7 +746,7 @@ int dgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DGESVXX", &i__1); + xerbla_("DGESVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgetc2.c b/src/map/lapack2flamec/f2c/c/dgetc2.c index 4bdf2498b..624cb87f0 100644 --- a/src/map/lapack2flamec/f2c/c/dgetc2.c +++ b/src/map/lapack2flamec/f2c/c/dgetc2.c @@ -148,6 +148,9 @@ int dgetc2_(integer *n, doublereal *a, integer *lda, integer *ipiv, integer *jpi --jpiv; /* Function Body */ *info = 0; + smin = 0; + jpv = 0; + ipv = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/dgetrf2.c b/src/map/lapack2flamec/f2c/c/dgetrf2.c index 106d08250..d8f046eb7 100644 --- a/src/map/lapack2flamec/f2c/c/dgetrf2.c +++ b/src/map/lapack2flamec/f2c/c/dgetrf2.c @@ -127,7 +127,7 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), dlaswp_( integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlaswp_( integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -153,6 +153,7 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv /* Parameter adjustments */ #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; + static TLS_CLASS_SPEC integer progress_size = 0; #endif a_dim1 = *lda; a_offset = 1 + a_dim1; @@ -175,7 +176,7 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRF2", &i__1); + xerbla_("DGETRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -246,9 +247,9 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv /* Factor [ --- ] */ /* [ A21 ] */ #if AOCL_FLA_PROGRESS_H - if(step_count == 0 || step_count==size ){ - size=fla_min(*m,*n); - step_count =1; + if(progress_step_count == 0 || progress_step_count == progress_size ){ + progress_size = fla_min(*m,*n); + progress_step_count = 1; } #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) @@ -256,10 +257,10 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv #endif if(aocl_fla_progress_ptr) { - ++step_count; - if((step_count%8)==0 || step_count==size) + ++progress_step_count; + if((progress_step_count%8)==0 || progress_step_count == progress_size) { - AOCL_FLA_PROGRESS_FUNC_PTR("DGETRF",6,&step_count,&thread_id,&total_threads); + AOCL_FLA_PROGRESS_FUNC_PTR("DGETRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } } @@ -304,4 +305,3 @@ int dgetrf2_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv /* End of DGETRF2 */ } /* dgetrf2_ */ - diff --git a/src/map/lapack2flamec/f2c/c/dgetri.c b/src/map/lapack2flamec/f2c/c/dgetri.c index afe9709e9..c90c49301 100644 --- a/src/map/lapack2flamec/f2c/c/dgetri.c +++ b/src/map/lapack2flamec/f2c/c/dgetri.c @@ -121,7 +121,7 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal * int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nbmin; extern /* Subroutine */ - int dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork; extern /* Subroutine */ @@ -176,7 +176,7 @@ int dgetri_(integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRI", &i__1); + xerbla_("DGETRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgetrs.c b/src/map/lapack2flamec/f2c/c/dgetrs.c index a5721fd95..c2114e5a1 100644 --- a/src/map/lapack2flamec/f2c/c/dgetrs.c +++ b/src/map/lapack2flamec/f2c/c/dgetrs.c @@ -1,6 +1,11 @@ +/* Modifications Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. */ /* ../netlib/dgetrs.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#if FLA_ENABLE_AOCL_BLAS +#include "blis.h" +#endif + static integer c__1 = 1; static doublereal c_b12 = 1.; static integer c_n1 = -1; @@ -112,50 +117,44 @@ for 1<=i<=N, row i of the */ /* > \ingroup doubleGEcomputational */ /* ===================================================================== */ /* Subroutine */ -int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer * ldb, integer *info) +int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info) { AOCL_DTL_TRACE_LOG_INIT - AOCL_DTL_SNPRINTF("dgetrs inputs: trans %c, n %" FLA_IS ", nrhs %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "",*trans, *n, *nrhs, *lda, *ldb); + AOCL_DTL_SNPRINTF("dgetrs inputs: trans %c, n %" FLA_IS ", nrhs %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS "", *trans, *n, *nrhs, *lda, *ldb); + + /* Initialize global context data */ + aocl_fla_init(); + /* System generated locals */ - integer a_dim1, a_offset, b_dim1, b_offset, i__1; + integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3; + integer b_index, a_index, j, i, k; + doublereal temp, inv_akk; + void dtrsm_LLNU_small(int *m, int *n, double *alpha, + double *a, int *lda, + double *b, int *ldb); + void dtrsm_LUNN_small(int *m, int *n, double *alpha, + double *a, int *lda, + double *b, int *ldb); /* Local variables */ - extern logical lsame_(char *, char *); +#ifndef FLA_ENABLE_AOCL_BLAS + extern logical lsame_(char *, char *, integer a, integer b); extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); + int + dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); +#endif + extern int dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ /* November 2011 */ - /* .. Scalar Arguments .. */ - /* .. */ - /* .. Array Arguments .. */ - /* .. */ /* ===================================================================== */ - /* .. Parameters .. */ - /* .. */ - /* .. Local Scalars .. */ - /* .. */ - /* .. External Functions .. */ - /* .. */ - /* .. External Subroutines .. */ - /* .. */ - /* .. Intrinsic Functions .. */ - /* .. */ - /* .. Executable Statements .. */ - /* Test the input parameters. */ - /* Parameter adjustments */ - a_dim1 = *lda; - a_offset = 1 + a_dim1; - a -= a_offset; - --ipiv; - b_dim1 = *ldb; - b_offset = 1 + b_dim1; - b -= b_offset; /* Function Body */ *info = 0; - notran = lsame_(trans, "N"); - if (! notran && ! lsame_(trans, "T") && ! lsame_( trans, "C")) + + notran = lsame_(trans, "N", 1, 1); + + if (! notran && ! lsame_(trans, "T", 1, 1) && ! lsame_( trans, "C", 1, 1)) { *info = -1; } @@ -167,18 +166,18 @@ int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, { *info = -3; } - else if (*lda < fla_max(1,*n)) + else if (*lda < fla_max(1, *n)) { *info = -5; } - else if (*ldb < fla_max(1,*n)) + else if (*ldb < fla_max(1, *n)) { *info = -8; } if (*info != 0) { i__1 = -(*info); - xerbla_("DGETRS", &i__1); + xerbla_("DGETRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -188,23 +187,71 @@ int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, AOCL_DTL_TRACE_LOG_EXIT return 0; } + +#ifdef FLA_ENABLE_AMD_OPT + /* Take small DGETRS path (NOTRANS) for size between 3 to 8 and NRHS <= N */ + if ((*n) > 2 && (*n) <= 8 && ((*nrhs) <= (*n)) && lsame_(trans, "N", 1, 1)) + { + fla_dgetrs_small_notrans(trans, n, nrhs, a, lda, ipiv, b, ldb, info); + AOCL_DTL_TRACE_LOG_EXIT + return 0; + } +#endif + + /* parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + --ipiv; + b_dim1 = *ldb; + b_offset = 1 + b_dim1; + b -= b_offset; + + /* DGETRS (NOTRANS) for size <= 2 */ + if (*n <= 2 && notran) + { + i__1 = *n; + i__2 = *nrhs; + + // Apply row interchanges to the right-hand sides. + for (j = 1; j <= i__2; j++) + { + integer b_index = j * b_dim1; + for (i = 1; i <= i__1; i++) + { + int ip = ipiv[i]; + if (ip != i) + { + doublereal temp = b[ip + b_index]; + b[ip + b_index] = b[i + b_index]; + b[i + b_index] = temp; + } + } + } + /* Solve L*X = B, overwriting B with X. */ + dtrsm_LLNU_small(n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); + /* Solve U*X = B, overwriting B with X. */ + dtrsm_LUNN_small(n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); + return 0; + } + if (notran) { /* Solve A * X = B. */ /* Apply row interchanges to the right hand sides. */ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1); /* Solve L*X = B, overwriting B with X. */ - dtrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); + dtrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); /* Solve U*X = B, overwriting B with X. */ - dtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b12, & a[a_offset], lda, &b[b_offset], ldb); + dtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); } else { /* Solve A**T * X = B. */ /* Solve U**T *X = B, overwriting B with X. */ - dtrsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); + dtrsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); /* Solve L**T *X = B, overwriting B with X. */ - dtrsm_("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b12, &a[ a_offset], lda, &b[b_offset], ldb); + dtrsm_("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb); /* Apply row interchanges to the solution vectors. */ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1); } @@ -213,3 +260,82 @@ int dgetrs_(char *trans, integer *n, integer *nrhs, doublereal *a, integer *lda, /* End of DGETRS */ } /* dgetrs_ */ + +// Function for dtrsm with SIDE='L', UPLO='L', TRANSA='N', DIAG='U' +void dtrsm_LLNU_small(int *m, int *n, double *alpha, + double *a, int *lda, + double *b, int *ldb) +{ + int i, j, k, i__1, i__, i__2, i__3; + int a_dim1, a_offset, b_dim1, b_offset; + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + i__1 = *n; + for (j = 1; + j <= i__1; + ++j) + { + i__2 = *m; + for (k = 1; + k <= i__2; + ++k) + { + if (b[k + j * b_dim1] != 0.) + { + i__3 = *m; + for (i__ = k + 1; + i__ <= i__3; + ++i__) + { + b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[i__ + k * a_dim1]; + } + } + } + } +} + +// Function for dtrsm with SIDE='L', UPLO='U', TRANSA='N', DIAG='N' +void dtrsm_LUNN_small(int *m, int *n, double *alpha, + double *a, int *lda, + double *b, int *ldb) +{ + int i, j, k, i__1, i__, i__2, i__3; + int a_dim1, a_offset, b_dim1, b_offset; + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + + i__1 = *n; + for (j = 1; + j <= i__1; + ++j) + { + for (k = *m; + k >= 1; + --k) + { + if (b[k + j * b_dim1] != 0.) + { + b[k + j * b_dim1] /= a[k + k * a_dim1]; + i__2 = k - 1; + for (i__ = 1; + i__ <= i__2; + ++i__) + { + b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[i__ + k * a_dim1]; + } + } + } + } +} \ No newline at end of file diff --git a/src/map/lapack2flamec/f2c/c/dgetsls.c b/src/map/lapack2flamec/f2c/c/dgetsls.c index a4e05e983..4e001ba9d 100644 --- a/src/map/lapack2flamec/f2c/c/dgetsls.c +++ b/src/map/lapack2flamec/f2c/c/dgetsls.c @@ -184,7 +184,7 @@ int dgetsls_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgemlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dgemqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dgemlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgemqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); integer scllen; doublereal bignum, smlnum; integer wsizem, wsizeo; @@ -307,7 +307,7 @@ int dgetsls_(char *trans, integer *m, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DGETSLS", &i__1); + xerbla_("DGETSLS", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgetsqrhrt.c b/src/map/lapack2flamec/f2c/c/dgetsqrhrt.c index 05de74048..25f42e2fd 100644 --- a/src/map/lapack2flamec/f2c/c/dgetsqrhrt.c +++ b/src/map/lapack2flamec/f2c/c/dgetsqrhrt.c @@ -182,7 +182,7 @@ int dgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 int dorgtsqr_row_(integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); integer iinfo; extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dlatsqr_(integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -301,7 +301,7 @@ int dgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 if (*info != 0) { i__1 = -(*info); - xerbla_("DGETSQRHRT", &i__1); + xerbla_("DGETSQRHRT", &i__1, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggbak.c b/src/map/lapack2flamec/f2c/c/dggbak.c index 9a6ff14a7..59d2a5979 100644 --- a/src/map/lapack2flamec/f2c/c/dggbak.c +++ b/src/map/lapack2flamec/f2c/c/dggbak.c @@ -152,7 +152,7 @@ int dggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical leftv; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -222,7 +222,7 @@ int dggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DGGBAK", &i__1); + xerbla_("DGGBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggbal.c b/src/map/lapack2flamec/f2c/c/dggbal.c index a2e181a4f..31aa38646 100644 --- a/src/map/lapack2flamec/f2c/c/dggbal.c +++ b/src/map/lapack2flamec/f2c/c/dggbal.c @@ -207,7 +207,7 @@ int dggbal_(char *job, integer *n, doublereal *a, integer * lda, doublereal *b, doublereal pgamma; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lsfmin, lsfmax; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -261,7 +261,7 @@ int dggbal_(char *job, integer *n, doublereal *a, integer * lda, doublereal *b, if (*info != 0) { i__1 = -(*info); - xerbla_("DGGBAL", &i__1); + xerbla_("DGGBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgges.c b/src/map/lapack2flamec/f2c/c/dgges.c index 052e6f5fc..02430db60 100644 --- a/src/map/lapack2flamec/f2c/c/dgges.c +++ b/src/map/lapack2flamec/f2c/c/dgges.c @@ -281,7 +281,7 @@ the routine */ /* > \ingroup doubleGEeigen */ /* ===================================================================== */ /* Subroutine */ -int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work, integer *lwork, logical *bwork, integer *info) +int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fpd3 selctg, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work, integer *lwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgges inputs: jobvsl %c, jobvsr %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS ", lwork %" FLA_IS "",*jobvsl, *jobvsr, *sort, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr, *lwork); @@ -315,7 +315,7 @@ int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doub int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dtgsen_(integer *, logical *, logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *); @@ -482,7 +482,7 @@ int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DGGES ", &i__1); + xerbla_("DGGES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgges3.c b/src/map/lapack2flamec/f2c/c/dgges3.c index 37d256928..00b4fb438 100644 --- a/src/map/lapack2flamec/f2c/c/dgges3.c +++ b/src/map/lapack2flamec/f2c/c/dgges3.c @@ -279,7 +279,7 @@ the routine */ /* > \ingroup doubleGEeigen */ /* ===================================================================== */ /* Subroutine */ -int dgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work, integer *lwork, logical *bwork, integer *info) +int dgges3_(char *jobvsl, char *jobvsr, char *sort, L_fpd3 selctg, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work, integer *lwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dgges3 inputs: jobvsl %c, jobvsr %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS ", lwork %" FLA_IS "",*jobvsl, *jobvsr, *sort, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr, *lwork); @@ -315,7 +315,7 @@ int dgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, dou int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dtgsen_(integer *, logical *, logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *); @@ -487,7 +487,7 @@ int dgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, dou if (*info != 0) { i__1 = -(*info); - xerbla_("DGGES3 ", &i__1); + xerbla_("DGGES3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggesx.c b/src/map/lapack2flamec/f2c/c/dggesx.c index 62b8e22e2..e13755396 100644 --- a/src/map/lapack2flamec/f2c/c/dggesx.c +++ b/src/map/lapack2flamec/f2c/c/dggesx.c @@ -366,7 +366,7 @@ the */ /* > */ /* ===================================================================== */ /* Subroutine */ -int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *rconde, doublereal * rcondv, doublereal *work, integer *lwork, integer *iwork, integer * liwork, logical *bwork, integer *info) +int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fpd3 selctg, char *sense, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *rconde, doublereal * rcondv, doublereal *work, integer *lwork, integer *iwork, integer * liwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dggesx inputs: jobvsl %c, jobvsr %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS ", lwork %" FLA_IS ", liwork %" FLA_IS "",*jobvsl, *jobvsr, *sort, *sense, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr, *lwork, *liwork); @@ -401,7 +401,7 @@ int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -622,7 +622,7 @@ int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in if (*info != 0) { i__1 = -(*info); - xerbla_("DGGESX", &i__1); + xerbla_("DGGESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggev.c b/src/map/lapack2flamec/f2c/c/dggev.c index 54c1a3e7f..9f3d69c69 100644 --- a/src/map/lapack2flamec/f2c/c/dggev.c +++ b/src/map/lapack2flamec/f2c/c/dggev.c @@ -253,7 +253,7 @@ int dggev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d char chtemp[1]; doublereal bignum; extern /* Subroutine */ - int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ijobvl, iright, ijobvr; extern /* Subroutine */ @@ -404,7 +404,7 @@ int dggev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGGEV ", &i__1); + xerbla_("DGGEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggev3.c b/src/map/lapack2flamec/f2c/c/dggev3.c index d98c9f719..cddca4d96 100644 --- a/src/map/lapack2flamec/f2c/c/dggev3.c +++ b/src/map/lapack2flamec/f2c/c/dggev3.c @@ -255,7 +255,7 @@ int dggev3_(char *jobvl, char *jobvr, integer *n, doublereal *a, integer *lda, d char chtemp[1]; doublereal bignum; extern /* Subroutine */ - int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijobvl, iright, ijobvr; extern /* Subroutine */ int dorgqr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); @@ -431,7 +431,7 @@ int dggev3_(char *jobvl, char *jobvr, integer *n, doublereal *a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGGEV3 ", &i__1); + xerbla_("DGGEV3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggevx.c b/src/map/lapack2flamec/f2c/c/dggevx.c index cdedfad84..7ccde230b 100644 --- a/src/map/lapack2flamec/f2c/c/dggevx.c +++ b/src/map/lapack2flamec/f2c/c/dggevx.c @@ -427,7 +427,7 @@ int dggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do int dhgeqz_(char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dtgevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer ijobvl; extern /* Subroutine */ - int dtgsna_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dtgsna_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ijobvr; logical wantsb; @@ -625,7 +625,7 @@ int dggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGGEVX", &i__1); + xerbla_("DGGEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggglm.c b/src/map/lapack2flamec/f2c/c/dggglm.c index 701004813..bab44bef8 100644 --- a/src/map/lapack2flamec/f2c/c/dggglm.c +++ b/src/map/lapack2flamec/f2c/c/dggglm.c @@ -187,7 +187,7 @@ int dggglm_(integer *n, integer *m, integer *p, doublereal * a, integer *lda, do /* Local variables */ integer i__, nb, np, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dggqrf_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dggqrf_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -281,7 +281,7 @@ int dggglm_(integer *n, integer *m, integer *p, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGGGLM", &i__1); + xerbla_("DGGGLM", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgghd3.c b/src/map/lapack2flamec/f2c/c/dgghd3.c index 90747ec9e..588531a17 100644 --- a/src/map/lapack2flamec/f2c/c/dgghd3.c +++ b/src/map/lapack2flamec/f2c/c/dgghd3.c @@ -272,7 +272,7 @@ int dgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d int dgghrd_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_( doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -365,7 +365,7 @@ int dgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGGHD3", &i__1); + xerbla_("DGGHD3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgghrd.c b/src/map/lapack2flamec/f2c/c/dgghrd.c index 414a554df..f2d49d062 100644 --- a/src/map/lapack2flamec/f2c/c/dgghrd.c +++ b/src/map/lapack2flamec/f2c/c/dgghrd.c @@ -220,7 +220,7 @@ int dgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d integer jrow; extern logical lsame_(char *, char *); extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icompq, icompz; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -337,7 +337,7 @@ int dgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d if (*info != 0) { i__1 = -(*info); - xerbla_("DGGHRD", &i__1); + xerbla_("DGGHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgglse.c b/src/map/lapack2flamec/f2c/c/dgglse.c index f28b903ca..31e2276af 100644 --- a/src/map/lapack2flamec/f2c/c/dgglse.c +++ b/src/map/lapack2flamec/f2c/c/dgglse.c @@ -182,7 +182,7 @@ int dgglse_(integer *m, integer *n, integer *p, doublereal * a, integer *lda, do /* Local variables */ integer nb, mn, nr, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dggrqf_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dggrqf_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -277,7 +277,7 @@ int dgglse_(integer *m, integer *n, integer *p, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGGLSE", &i__1); + xerbla_("DGGLSE", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggqrf.c b/src/map/lapack2flamec/f2c/c/dggqrf.c index 0a3e90f3f..67a5fa7a5 100644 --- a/src/map/lapack2flamec/f2c/c/dggqrf.c +++ b/src/map/lapack2flamec/f2c/c/dggqrf.c @@ -218,7 +218,7 @@ int dggqrf_(integer *n, integer *m, integer *p, doublereal * a, integer *lda, do /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgerqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgerqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -299,7 +299,7 @@ int dggqrf_(integer *n, integer *m, integer *p, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGGQRF", &i__1); + xerbla_("DGGQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggrqf.c b/src/map/lapack2flamec/f2c/c/dggrqf.c index 4050d385f..6d96cdfed 100644 --- a/src/map/lapack2flamec/f2c/c/dggrqf.c +++ b/src/map/lapack2flamec/f2c/c/dggrqf.c @@ -217,7 +217,7 @@ int dggrqf_(integer *m, integer *p, integer *n, doublereal * a, integer *lda, do /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgerqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgerqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dormrq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -298,7 +298,7 @@ int dggrqf_(integer *m, integer *p, integer *n, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGGRQF", &i__1); + xerbla_("DGGRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggsvd.c b/src/map/lapack2flamec/f2c/c/dggsvd.c index 3a8b3bb1d..e212be035 100644 --- a/src/map/lapack2flamec/f2c/c/dggsvd.c +++ b/src/map/lapack2flamec/f2c/c/dggsvd.c @@ -347,7 +347,7 @@ int dggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer int dtgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *), dggsvp_( char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dggsvp_( char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -439,7 +439,7 @@ int dggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVD", &i__1); + xerbla_("DGGSVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggsvd3.c b/src/map/lapack2flamec/f2c/c/dggsvd3.c index ff4a49a15..0d5783c18 100644 --- a/src/map/lapack2flamec/f2c/c/dggsvd3.c +++ b/src/map/lapack2flamec/f2c/c/dggsvd3.c @@ -365,7 +365,7 @@ int dggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer int dtgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -479,7 +479,7 @@ int dggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVD3", &i__1); + xerbla_("DGGSVD3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggsvp.c b/src/map/lapack2flamec/f2c/c/dggsvp.c index 58fa0514d..efb8369e9 100644 --- a/src/map/lapack2flamec/f2c/c/dggsvp.c +++ b/src/map/lapack2flamec/f2c/c/dggsvp.c @@ -262,7 +262,7 @@ int dggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int dgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgerq2_( integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgeqpf_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); + int dgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgerq2_( integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgeqpf_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); logical forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -357,7 +357,7 @@ int dggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVP", &i__1); + xerbla_("DGGSVP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dggsvp3.c b/src/map/lapack2flamec/f2c/c/dggsvp3.c index 0e3fb67c3..5a196a08b 100644 --- a/src/map/lapack2flamec/f2c/c/dggsvp3.c +++ b/src/map/lapack2flamec/f2c/c/dggsvp3.c @@ -282,7 +282,7 @@ int dggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int dgeqp3_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, integer *), dgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgerq2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); + int dgeqp3_(integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *, integer *), dgeqr2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgerq2_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorm2r_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); logical forwrd; integer lwkopt; logical lquery; @@ -412,7 +412,7 @@ int dggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DGGSVP3", &i__1); + xerbla_("DGGSVP3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgsvj0.c b/src/map/lapack2flamec/f2c/c/dgsvj0.c index 085300b96..9330e17af 100644 --- a/src/map/lapack2flamec/f2c/c/dgsvj0.c +++ b/src/map/lapack2flamec/f2c/c/dgsvj0.c @@ -243,7 +243,7 @@ int dgsvj0_(char *jobv, integer *m, integer *n, doublereal * a, integer *lda, do int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband, blskip; doublereal mxaapq; extern /* Subroutine */ @@ -333,7 +333,7 @@ int dgsvj0_(char *jobv, integer *m, integer *n, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DGSVJ0", &i__1); + xerbla_("DGSVJ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgsvj1.c b/src/map/lapack2flamec/f2c/c/dgsvj1.c index 890e0cc03..2254ef934 100644 --- a/src/map/lapack2flamec/f2c/c/dgsvj1.c +++ b/src/map/lapack2flamec/f2c/c/dgsvj1.c @@ -245,7 +245,7 @@ int dgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublereal *a, inte integer nblr, ierr; doublereal aapp0; extern doublereal dnrm2_(integer *, doublereal *, integer *); - doublereal temp1, large, apoaq, aqoap; + doublereal temp1, apoaq, aqoap; extern logical lsame_(char *, char *); doublereal theta, small_val; extern /* Subroutine */ @@ -261,7 +261,7 @@ int dgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublereal *a, inte int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband, blskip; doublereal mxaapq; extern /* Subroutine */ @@ -355,7 +355,7 @@ int dgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DGSVJ1", &i__1); + xerbla_("DGSVJ1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -373,7 +373,6 @@ int dgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublereal *a, inte small_val = *sfmin / *eps; big = 1. / *sfmin; rootbig = 1. / rootsfmin; - large = big / sqrt((doublereal) (*m * *n)); bigtheta = 1. / rooteps; roottol = sqrt(*tol); /* .. Initialize the right singular vector matrix .. */ diff --git a/src/map/lapack2flamec/f2c/c/dgtcon.c b/src/map/lapack2flamec/f2c/c/dgtcon.c index cbec59466..99f3a92ff 100644 --- a/src/map/lapack2flamec/f2c/c/dgtcon.c +++ b/src/map/lapack2flamec/f2c/c/dgtcon.c @@ -147,7 +147,7 @@ int dgtcon_(char *norm, integer *n, doublereal *dl, doublereal *d__, doublereal extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; logical onenrm; extern /* Subroutine */ @@ -199,7 +199,7 @@ int dgtcon_(char *norm, integer *n, doublereal *dl, doublereal *d__, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DGTCON", &i__1); + xerbla_("DGTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgtrfs.c b/src/map/lapack2flamec/f2c/c/dgtrfs.c index f88c86b6f..f1263c0b9 100644 --- a/src/map/lapack2flamec/f2c/c/dgtrfs.c +++ b/src/map/lapack2flamec/f2c/c/dgtrfs.c @@ -224,7 +224,7 @@ int dgtrfs_(char *trans, integer *n, integer *nrhs, doublereal *dl, doublereal * int dlagtm_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1]; extern /* Subroutine */ @@ -299,7 +299,7 @@ int dgtrfs_(char *trans, integer *n, integer *nrhs, doublereal *dl, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DGTRFS", &i__1); + xerbla_("DGTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgtsv.c b/src/map/lapack2flamec/f2c/c/dgtsv.c index 12a67a612..4aad32941 100644 --- a/src/map/lapack2flamec/f2c/c/dgtsv.c +++ b/src/map/lapack2flamec/f2c/c/dgtsv.c @@ -124,7 +124,7 @@ int dgtsv_(integer *n, integer *nrhs, doublereal *dl, doublereal *d__, doublerea integer i__, j; doublereal fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int dgtsv_(integer *n, integer *nrhs, doublereal *dl, doublereal *d__, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DGTSV ", &i__1); + xerbla_("DGTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgtsvx.c b/src/map/lapack2flamec/f2c/c/dgtsvx.c index 1e1b61467..e4f0c371f 100644 --- a/src/map/lapack2flamec/f2c/c/dgtsvx.c +++ b/src/map/lapack2flamec/f2c/c/dgtsvx.c @@ -296,7 +296,7 @@ int dgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *dl, extern doublereal dlamch_(char *), dlangt_(char *, integer *, doublereal *, doublereal *, doublereal *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dgtcon_(char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgtrfs_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgttrf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgtcon_(char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgtrfs_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dgttrf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); logical notran; extern /* Subroutine */ int dgttrs_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -370,7 +370,7 @@ int dgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, doublereal *dl, if (*info != 0) { i__1 = -(*info); - xerbla_("DGTSVX", &i__1); + xerbla_("DGTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgttrf.c b/src/map/lapack2flamec/f2c/c/dgttrf.c index a6a82522f..854f8e917 100644 --- a/src/map/lapack2flamec/f2c/c/dgttrf.c +++ b/src/map/lapack2flamec/f2c/c/dgttrf.c @@ -123,7 +123,7 @@ int dgttrf_(integer *n, doublereal *dl, doublereal *d__, doublereal *du, doubler integer i__; doublereal fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int dgttrf_(integer *n, doublereal *dl, doublereal *d__, doublereal *du, doubler { *info = -1; i__1 = -(*info); - xerbla_("DGTTRF", &i__1); + xerbla_("DGTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dgttrs.c b/src/map/lapack2flamec/f2c/c/dgttrs.c index 2b06905bb..9e3578325 100644 --- a/src/map/lapack2flamec/f2c/c/dgttrs.c +++ b/src/map/lapack2flamec/f2c/c/dgttrs.c @@ -137,7 +137,7 @@ int dgttrs_(char *trans, integer *n, integer *nrhs, doublereal *dl, doublereal * /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int dgtts2_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgtts2_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer itrans; logical notran; @@ -190,7 +190,7 @@ int dgttrs_(char *trans, integer *n, integer *nrhs, doublereal *dl, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DGTTRS", &i__1); + xerbla_("DGTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dhgeqz.c b/src/map/lapack2flamec/f2c/c/dhgeqz.c index 0e7d863f8..731a7969f 100644 --- a/src/map/lapack2flamec/f2c/c/dhgeqz.c +++ b/src/map/lapack2flamec/f2c/c/dhgeqz.c @@ -1,5 +1,10 @@ /* dhgeqz.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ + +/* + Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ + #include "FLA_f2c.h" /* Table of constant values */ static doublereal c_b12 = 0.; static doublereal c_b13 = 1.; @@ -314,7 +319,7 @@ int dhgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ aocl_fla_init(); int retval = 0; -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT if (global_context.is_avx2) { retval = fla_dhgeqz_opt(job, compq, compz, n, ilo, ihi, h__, ldh, t, ldt, alphar, alphai, beta, q, ldq, z__, ldz, work, lwork, info); @@ -331,6 +336,7 @@ int dhgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ return retval; } +#if FLA_ENABLE_AMD_OPT int fla_dhgeqz_opt(char *job, char *compq, char *compz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *t, integer *ldt, doublereal *alphar, doublereal *alphai, doublereal * beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ @@ -378,7 +384,7 @@ int fla_dhgeqz_opt(char *job, char *compq, char *compz, integer *n, integer *ilo int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal eshift; logical ilschr; integer icompq, ilastm, ischur; @@ -430,6 +436,9 @@ int fla_dhgeqz_opt(char *job, char *compq, char *compz, integer *n, integer *ilo z__ -= z_offset; --work; /* Function Body */ + ilz = FALSE_; + ilq = FALSE_; + ilschr = FALSE_; if (lsame_(job, "E")) { ilschr = FALSE_; @@ -533,7 +542,7 @@ int fla_dhgeqz_opt(char *job, char *compq, char *compz, integer *n, integer *ilo if (*info != 0) { i__1 = -(*info); - xerbla_("DHGEQZ", &i__1); + xerbla_("DHGEQZ", &i__1, (ftnlen)6); return 0; } else if (lquery) @@ -1582,6 +1591,7 @@ int fla_dhgeqz_opt(char *job, char *compq, char *compz, integer *n, integer *ilo return 0; /* End of DHGEQZ */ } +#endif int fla_dhgeqz_native(char *job, char *compq, char *compz, integer *n, integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal *t, integer *ldt, doublereal *alphar, doublereal *alphai, doublereal * beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info) { @@ -1631,7 +1641,7 @@ int fla_dhgeqz_native(char *job, char *compq, char *compz, integer *n, integer * int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal eshift; logical ilschr; integer icompq, ilastm, ischur; @@ -1681,6 +1691,9 @@ int fla_dhgeqz_native(char *job, char *compq, char *compz, integer *n, integer * z__ -= z_offset; --work; /* Function Body */ + ilz = FALSE_; + ilq = FALSE_; + ilschr = FALSE_; if (lsame_(job, "E")) { ilschr = FALSE_; @@ -1784,7 +1797,7 @@ int fla_dhgeqz_native(char *job, char *compq, char *compz, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DHGEQZ", &i__1); + xerbla_("DHGEQZ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/dhsein.c b/src/map/lapack2flamec/f2c/c/dhsein.c index 6fa711130..fb93a67f0 100644 --- a/src/map/lapack2flamec/f2c/c/dhsein.c +++ b/src/map/lapack2flamec/f2c/c/dhsein.c @@ -289,7 +289,7 @@ int dhsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, extern doublereal dlanhs_(char *, integer *, doublereal *, integer *, doublereal *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical noinit; integer ldwork; @@ -409,7 +409,7 @@ int dhsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, if (*info != 0) { i__1 = -(*info); - xerbla_("DHSEIN", &i__1); + xerbla_("DHSEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dhseqr.c b/src/map/lapack2flamec/f2c/c/dhseqr.c index 3429bfa2b..f1eca3c24 100644 --- a/src/map/lapack2flamec/f2c/c/dhseqr.c +++ b/src/map/lapack2flamec/f2c/c/dhseqr.c @@ -4,7 +4,6 @@ static doublereal c_b11 = 0.; static doublereal c_b12 = 1.; static integer c__12 = 12; -static integer c__2 = 2; static integer c__49 = 49; /* > \brief \b DHSEQR */ /* =========== DOCUMENTATION =========== */ @@ -312,8 +311,7 @@ int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dhseqr inputs: job %c, compz %c, n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", ldh %" FLA_IS ", ldz %" FLA_IS ", lwork %" FLA_IS "",*job, *compz, *n, *ilo, *ihi, *ldh, *ldz, *lwork); /* System generated locals */ - address a__1[2]; - integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2[2], i__3; + integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__3; doublereal d__1; char ch__1[2]; /* Builtin functions */ @@ -332,7 +330,7 @@ int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub int dlaqr0_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -418,7 +416,7 @@ int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub { /* ==== Quick return in case of invalid argument. ==== */ i__1 = -(*info); - xerbla_("DHSEQR", &i__1); + xerbla_("DHSEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dla_gbamv.c b/src/map/lapack2flamec/f2c/c/dla_gbamv.c index 9d6df29ed..86c2d7c11 100644 --- a/src/map/lapack2flamec/f2c/c/dla_gbamv.c +++ b/src/map/lapack2flamec/f2c/c/dla_gbamv.c @@ -189,7 +189,7 @@ int dla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, doublereal safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -253,7 +253,7 @@ int dla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, } if (info != 0) { - xerbla_("DLA_GBAMV ", &info); + xerbla_("DLA_GBAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dla_gbrcond.c b/src/map/lapack2flamec/f2c/c/dla_gbrcond.c index 4da54a9e0..c4c8f0c22 100644 --- a/src/map/lapack2flamec/f2c/c/dla_gbrcond.c +++ b/src/map/lapack2flamec/f2c/c/dla_gbrcond.c @@ -170,7 +170,7 @@ doublereal dla_gbrcond_(char *trans, integer *n, integer *kl, integer *ku, doubl extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *), dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgbtrs_(char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal ainvnm; logical notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -235,7 +235,7 @@ doublereal dla_gbrcond_(char *trans, integer *n, integer *kl, integer *ku, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DLA_GBRCOND", &i__1); + xerbla_("DLA_GBRCOND", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/dla_geamv.c b/src/map/lapack2flamec/f2c/c/dla_geamv.c index 303d9008d..d0afa7b97 100644 --- a/src/map/lapack2flamec/f2c/c/dla_geamv.c +++ b/src/map/lapack2flamec/f2c/c/dla_geamv.c @@ -178,7 +178,7 @@ int dla_geamv_(integer *trans, integer *m, integer *n, doublereal *alpha, double doublereal safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -234,7 +234,7 @@ int dla_geamv_(integer *trans, integer *m, integer *n, doublereal *alpha, double } if (info != 0) { - xerbla_("DLA_GEAMV ", &info); + xerbla_("DLA_GEAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dla_gercond.c b/src/map/lapack2flamec/f2c/c/dla_gercond.c index 2136522f9..cc898922c 100644 --- a/src/map/lapack2flamec/f2c/c/dla_gercond.c +++ b/src/map/lapack2flamec/f2c/c/dla_gercond.c @@ -152,7 +152,7 @@ doublereal dla_gercond_(char *trans, integer *n, doublereal *a, integer *lda, do extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -211,7 +211,7 @@ doublereal dla_gercond_(char *trans, integer *n, doublereal *a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DLA_GERCOND", &i__1); + xerbla_("DLA_GERCOND", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/dla_porcond.c b/src/map/lapack2flamec/f2c/c/dla_porcond.c index d3ae3a228..f411db3ca 100644 --- a/src/map/lapack2flamec/f2c/c/dla_porcond.c +++ b/src/map/lapack2flamec/f2c/c/dla_porcond.c @@ -143,7 +143,7 @@ doublereal dla_porcond_(char *uplo, integer *n, doublereal *a, integer *lda, dou extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dpotrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -187,7 +187,7 @@ doublereal dla_porcond_(char *uplo, integer *n, doublereal *a, integer *lda, dou if (*info != 0) { i__1 = -(*info); - xerbla_("DLA_PORCOND", &i__1); + xerbla_("DLA_PORCOND", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/dla_syamv.c b/src/map/lapack2flamec/f2c/c/dla_syamv.c index e46b31562..0c5afbffd 100644 --- a/src/map/lapack2flamec/f2c/c/dla_syamv.c +++ b/src/map/lapack2flamec/f2c/c/dla_syamv.c @@ -178,7 +178,7 @@ int dla_syamv_(integer *uplo, integer *n, doublereal *alpha, doublereal *a, inte doublereal temp, safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int dla_syamv_(integer *uplo, integer *n, doublereal *alpha, doublereal *a, inte } if (info != 0) { - xerbla_("DLA_SYAMV", &info); + xerbla_("DLA_SYAMV", &info, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dla_syrcond.c b/src/map/lapack2flamec/f2c/c/dla_syrcond.c index 477b80636..8331be43f 100644 --- a/src/map/lapack2flamec/f2c/c/dla_syrcond.c +++ b/src/map/lapack2flamec/f2c/c/dla_syrcond.c @@ -152,10 +152,9 @@ doublereal dla_syrcond_(char *uplo, integer *n, doublereal *a, integer *lda, dou int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; char normin[1]; - doublereal smlnum; extern /* Subroutine */ int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -207,7 +206,7 @@ doublereal dla_syrcond_(char *uplo, integer *n, doublereal *a, integer *lda, dou if (*info != 0) { i__1 = -(*info); - xerbla_("DLA_SYRCOND", &i__1); + xerbla_("DLA_SYRCOND", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } @@ -349,7 +348,6 @@ doublereal dla_syrcond_(char *uplo, integer *n, doublereal *a, integer *lda, dou } } /* Estimate the norm of inv(op(A)). */ - smlnum = dlamch_("Safe minimum"); ainvnm = 0.; *(unsigned char *)normin = 'N'; kase = 0; diff --git a/src/map/lapack2flamec/f2c/c/dla_syrfsx_extended.c b/src/map/lapack2flamec/f2c/c/dla_syrfsx_extended.c index 4cdb1ac15..83dbf51bb 100644 --- a/src/map/lapack2flamec/f2c/c/dla_syrfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/dla_syrfsx_extended.c @@ -426,7 +426,7 @@ int dla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * doublereal normx, normy; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal normdx; extern /* Subroutine */ int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -513,7 +513,7 @@ int dla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DLA_SYRFSX_EXTENDED", &i__1); + xerbla_("DLA_SYRFSX_EXTENDED", &i__1, (ftnlen)19); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlabad.c b/src/map/lapack2flamec/f2c/c/dlabad.c index 0913d342f..34a09361a 100644 --- a/src/map/lapack2flamec/f2c/c/dlabad.c +++ b/src/map/lapack2flamec/f2c/c/dlabad.c @@ -64,6 +64,7 @@ int dlabad_(doublereal *small_val, doublereal *large) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dlabad inputs: small_val %lf, large %lf", *small_val, *large); + extern double d_lg10(doublereal *x); /* -- LAPACK auxiliary routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ diff --git a/src/map/lapack2flamec/f2c/c/dlabrd.c b/src/map/lapack2flamec/f2c/c/dlabrd.c index 2a086fa0e..d76aae0e9 100644 --- a/src/map/lapack2flamec/f2c/c/dlabrd.c +++ b/src/map/lapack2flamec/f2c/c/dlabrd.c @@ -271,16 +271,17 @@ int fla_dlabrd(integer *m, integer *n, integer *nb, doublereal * a, integer *lda y_offset = 1 + y_dim1; y -= y_offset; -#ifdef FLA_OPENMP_MULTITHREADING - /* Get optimum thread number for DLABRD*/ - FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); -#endif - /* Function Body */ if (*m <= 0 || *n <= 0) { return 0; } + +#ifdef FLA_OPENMP_MULTITHREADING + /* Get optimum thread number for DLABRD*/ + FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); +#endif + if (*m >= *n) { /* Reduce to upper bidiagonal form */ diff --git a/src/map/lapack2flamec/f2c/c/dlaed0.c b/src/map/lapack2flamec/f2c/c/dlaed0.c index 82311bd81..f64ef29ae 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed0.c +++ b/src/map/lapack2flamec/f2c/c/dlaed0.c @@ -193,7 +193,7 @@ int dlaed0_(integer *icompq, integer *qsiz, integer *n, doublereal *d__, doubler int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); integer igivcl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer igivnm, submat, curprb, subpbs, igivpt; extern /* Subroutine */ @@ -233,6 +233,13 @@ int dlaed0_(integer *icompq, integer *qsiz, integer *n, doublereal *d__, doubler --iwork; /* Function Body */ *info = 0; + iprmpt = 0; + igivpt = 0; + igivcl = 0; + iqptr = 0; + iwrem = 0; + iperm = 0; + iq = 0; if (*icompq < 0 || *icompq > 2) { *info = -1; @@ -256,7 +263,7 @@ int dlaed0_(integer *icompq, integer *qsiz, integer *n, doublereal *d__, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED0", &i__1); + xerbla_("DLAED0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed1.c b/src/map/lapack2flamec/f2c/c/dlaed1.c index 98c5490f5..4287d2e30 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed1.c +++ b/src/map/lapack2flamec/f2c/c/dlaed1.c @@ -166,7 +166,7 @@ int dlaed1_(integer *n, doublereal *d__, doublereal *q, integer *ldq, integer *i int dlaed2_(integer *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, integer *), dlaed3_(integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, integer *); integer idlmda; extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer coltyp; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -216,7 +216,7 @@ int dlaed1_(integer *n, doublereal *d__, doublereal *q, integer *ldq, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED1", &i__1); + xerbla_("DLAED1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed2.c b/src/map/lapack2flamec/f2c/c/dlaed2.c index c19f63eae..fdbc643f0 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed2.c +++ b/src/map/lapack2flamec/f2c/c/dlaed2.c @@ -227,7 +227,7 @@ int dlaed2_(integer *k, integer *n, integer *n1, doublereal * d__, doublereal *q extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -267,6 +267,7 @@ int dlaed2_(integer *k, integer *n, integer *n1, doublereal * d__, doublereal *q --coltyp; /* Function Body */ *info = 0; + pj = 0; if (*n < 0) { *info = -2; @@ -288,7 +289,7 @@ int dlaed2_(integer *k, integer *n, integer *n1, doublereal * d__, doublereal *q if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED2", &i__1); + xerbla_("DLAED2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed3.c b/src/map/lapack2flamec/f2c/c/dlaed3.c index 1e0992440..bf6f512fb 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed3.c +++ b/src/map/lapack2flamec/f2c/c/dlaed3.c @@ -191,7 +191,7 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal * d__, doublereal *q int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlaed4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -241,7 +241,7 @@ int dlaed3_(integer *k, integer *n, integer *n1, doublereal * d__, doublereal *q if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED3", &i__1); + xerbla_("DLAED3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed6.c b/src/map/lapack2flamec/f2c/c/dlaed6.c index fd44b738a..ad84ea4bc 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed6.c +++ b/src/map/lapack2flamec/f2c/c/dlaed6.c @@ -172,6 +172,7 @@ int dlaed6_(integer *kniter, logical *orgati, doublereal * rho, doublereal *d__, --d__; /* Function Body */ *info = 0; + sclinv = 0.; if (*orgati) { lbd = d__[2]; diff --git a/src/map/lapack2flamec/f2c/c/dlaed7.c b/src/map/lapack2flamec/f2c/c/dlaed7.c index cfca497fe..1d9e6e84e 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed7.c +++ b/src/map/lapack2flamec/f2c/c/dlaed7.c @@ -265,7 +265,7 @@ int dlaed7_(integer *icompq, integer *n, integer *qsiz, integer *tlvls, integer int dlaed8_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dlaed9_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlaeda_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *) ; integer idlmda; extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer coltyp; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -326,7 +326,7 @@ int dlaed7_(integer *icompq, integer *n, integer *qsiz, integer *tlvls, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED7", &i__1); + xerbla_("DLAED7", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed8.c b/src/map/lapack2flamec/f2c/c/dlaed8.c index 63dba5060..68ee74138 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed8.c +++ b/src/map/lapack2flamec/f2c/c/dlaed8.c @@ -250,7 +250,7 @@ int dlaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, doublereal * extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -291,6 +291,7 @@ int dlaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, doublereal * --indx; /* Function Body */ *info = 0; + jlam = 0; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -318,7 +319,7 @@ int dlaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED8", &i__1); + xerbla_("DLAED8", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaed9.c b/src/map/lapack2flamec/f2c/c/dlaed9.c index 64a0f48c2..81d8cc9b5 100644 --- a/src/map/lapack2flamec/f2c/c/dlaed9.c +++ b/src/map/lapack2flamec/f2c/c/dlaed9.c @@ -159,7 +159,7 @@ int dlaed9_(integer *k, integer *kstart, integer *kstop, integer *n, doublereal int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlaed4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -218,7 +218,7 @@ int dlaed9_(integer *k, integer *kstart, integer *kstop, integer *n, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DLAED9", &i__1); + xerbla_("DLAED9", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaeda.c b/src/map/lapack2flamec/f2c/c/dlaeda.c index f6a9b4dbc..9c4dabb19 100644 --- a/src/map/lapack2flamec/f2c/c/dlaeda.c +++ b/src/map/lapack2flamec/f2c/c/dlaeda.c @@ -170,7 +170,7 @@ int dlaeda_(integer *n, integer *tlvls, integer *curlvl, integer *curpbm, intege int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); integer curr, bsiz1, bsiz2, psiz1, psiz2, zptr1; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -209,7 +209,7 @@ int dlaeda_(integer *n, integer *tlvls, integer *curlvl, integer *curpbm, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DLAEDA", &i__1); + xerbla_("DLAEDA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlagtf.c b/src/map/lapack2flamec/f2c/c/dlagtf.c index c834e0610..3195ba27f 100644 --- a/src/map/lapack2flamec/f2c/c/dlagtf.c +++ b/src/map/lapack2flamec/f2c/c/dlagtf.c @@ -154,7 +154,7 @@ int dlagtf_(integer *n, doublereal *a, doublereal *lambda, doublereal *b, double doublereal tl, eps, piv1, piv2, temp, mult, scale1, scale2; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -187,7 +187,7 @@ int dlagtf_(integer *n, doublereal *a, doublereal *lambda, doublereal *b, double { *info = -1; i__1 = -(*info); - xerbla_("DLAGTF", &i__1); + xerbla_("DLAGTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlagts.c b/src/map/lapack2flamec/f2c/c/dlagts.c index 089d61a63..7929b5e8a 100644 --- a/src/map/lapack2flamec/f2c/c/dlagts.c +++ b/src/map/lapack2flamec/f2c/c/dlagts.c @@ -161,7 +161,7 @@ int dlagts_(integer *job, integer *n, doublereal *a, doublereal *b, doublereal * doublereal ak, eps, temp, pert, absak, sfmin; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -203,7 +203,7 @@ int dlagts_(integer *job, integer *n, doublereal *a, doublereal *b, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DLAGTS", &i__1); + xerbla_("DLAGTS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlahqr.c b/src/map/lapack2flamec/f2c/c/dlahqr.c index 05173f183..ff7f5599b 100644 --- a/src/map/lapack2flamec/f2c/c/dlahqr.c +++ b/src/map/lapack2flamec/f2c/c/dlahqr.c @@ -265,6 +265,7 @@ int dlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i z__ -= z_offset; /* Function Body */ *info = 0; + i2 = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlahr2.c b/src/map/lapack2flamec/f2c/c/dlahr2.c index cf71c9f9f..32449d54d 100644 --- a/src/map/lapack2flamec/f2c/c/dlahr2.c +++ b/src/map/lapack2flamec/f2c/c/dlahr2.c @@ -217,6 +217,7 @@ int dlahr2_(integer *n, integer *k, integer *nb, doublereal * a, integer *lda, d y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei = 0; if (*n <= 1) { AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/f2c/c/dlahrd.c b/src/map/lapack2flamec/f2c/c/dlahrd.c index 15f80f584..b913a5613 100644 --- a/src/map/lapack2flamec/f2c/c/dlahrd.c +++ b/src/map/lapack2flamec/f2c/c/dlahrd.c @@ -205,6 +205,7 @@ int dlahrd_(integer *n, integer *k, integer *nb, doublereal * a, integer *lda, d y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei = 0.; if (*n <= 1) { AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/f2c/c/dlals0.c b/src/map/lapack2flamec/f2c/c/dlals0.c index b5661dc57..fde4ae767 100644 --- a/src/map/lapack2flamec/f2c/c/dlals0.c +++ b/src/map/lapack2flamec/f2c/c/dlals0.c @@ -281,7 +281,7 @@ int dlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal dsigjp; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -329,6 +329,7 @@ int dlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n --work; /* Function Body */ *info = 0; + difrj = 0.; n = *nl + *nr + 1; if (*icompq < 0 || *icompq > 1) { @@ -377,7 +378,7 @@ int dlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n if (*info != 0) { i__1 = -(*info); - xerbla_("DLALS0", &i__1); + xerbla_("DLALS0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlalsa.c b/src/map/lapack2flamec/f2c/c/dlalsa.c index 7d258774c..729818e1a 100644 --- a/src/map/lapack2flamec/f2c/c/dlalsa.c +++ b/src/map/lapack2flamec/f2c/c/dlalsa.c @@ -270,7 +270,7 @@ int dlalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, doubler int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer inode, ndiml, ndimr; extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlals0_(integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlals0_(integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -365,7 +365,7 @@ int dlalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DLALSA", &i__1); + xerbla_("DLALSA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlalsd.c b/src/map/lapack2flamec/f2c/c/dlalsd.c index 4294ba1bf..ba4a3fb6e 100644 --- a/src/map/lapack2flamec/f2c/c/dlalsd.c +++ b/src/map/lapack2flamec/f2c/c/dlalsd.c @@ -203,7 +203,7 @@ int dlalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, doublereal * int dlasda_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlalsa_(integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer givcol; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -256,7 +256,7 @@ int dlalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DLALSD", &i__1); + xerbla_("DLALSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlamswlq.c b/src/map/lapack2flamec/f2c/c/dlamswlq.c index c18932a0d..23d4e2faa 100644 --- a/src/map/lapack2flamec/f2c/c/dlamswlq.c +++ b/src/map/lapack2flamec/f2c/c/dlamswlq.c @@ -203,7 +203,7 @@ int dlamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int dgemlqt_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpmlqt_(char *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -292,7 +292,7 @@ int dlamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DLAMSWLQ", &i__1); + xerbla_("DLAMSWLQ", &i__1, (ftnlen)8); work[1] = (doublereal) lw; AOCL_DTL_TRACE_LOG_EXIT return 0; diff --git a/src/map/lapack2flamec/f2c/c/dlamtsqr.c b/src/map/lapack2flamec/f2c/c/dlamtsqr.c index 147c49396..c72ffef22 100644 --- a/src/map/lapack2flamec/f2c/c/dlamtsqr.c +++ b/src/map/lapack2flamec/f2c/c/dlamtsqr.c @@ -207,7 +207,7 @@ int dlamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int dgemqrt_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpmqrt_(char *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -303,7 +303,7 @@ int dlamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DLAMTSQR", &i__1); + xerbla_("DLAMTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlangb.c b/src/map/lapack2flamec/f2c/c/dlangb.c index 71f76ebca..b77aca34d 100644 --- a/src/map/lapack2flamec/f2c/c/dlangb.c +++ b/src/map/lapack2flamec/f2c/c/dlangb.c @@ -151,6 +151,7 @@ doublereal dlangb_(char *norm, integer *n, integer *kl, integer *ku, doublereal ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlange.c b/src/map/lapack2flamec/f2c/c/dlange.c index 1c1a20085..90268bb82 100644 --- a/src/map/lapack2flamec/f2c/c/dlange.c +++ b/src/map/lapack2flamec/f2c/c/dlange.c @@ -142,6 +142,7 @@ doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer *l a -= a_offset; --work; /* Function Body */ + value = 0.; if (fla_min(*m,*n) == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlangt.c b/src/map/lapack2flamec/f2c/c/dlangt.c index 478097376..4ec166b83 100644 --- a/src/map/lapack2flamec/f2c/c/dlangt.c +++ b/src/map/lapack2flamec/f2c/c/dlangt.c @@ -135,6 +135,7 @@ doublereal dlangt_(char *norm, integer *n, doublereal *dl, doublereal *d__, doub --d__; --dl; /* Function Body */ + anorm = 0.; if (*n <= 0) { anorm = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlanhs.c b/src/map/lapack2flamec/f2c/c/dlanhs.c index 4c6cca8ce..73e217855 100644 --- a/src/map/lapack2flamec/f2c/c/dlanhs.c +++ b/src/map/lapack2flamec/f2c/c/dlanhs.c @@ -138,6 +138,7 @@ doublereal dlanhs_(char *norm, integer *n, doublereal *a, integer *lda, doublere a -= a_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlansb.c b/src/map/lapack2flamec/f2c/c/dlansb.c index a13cb18e2..34bac7bd8 100644 --- a/src/map/lapack2flamec/f2c/c/dlansb.c +++ b/src/map/lapack2flamec/f2c/c/dlansb.c @@ -157,6 +157,7 @@ doublereal dlansb_(char *norm, char *uplo, integer *n, integer *k, doublereal *a ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlansf.c b/src/map/lapack2flamec/f2c/c/dlansf.c index 51017d9ed..3eed9cb3f 100644 --- a/src/map/lapack2flamec/f2c/c/dlansf.c +++ b/src/map/lapack2flamec/f2c/c/dlansf.c @@ -240,6 +240,7 @@ doublereal dlansf_(char *norm, char *transr, char *uplo, integer *n, doublereal /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + value = 0.; if (*n == 0) { ret_val = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlansp.c b/src/map/lapack2flamec/f2c/c/dlansp.c index 166521c50..98776a7cb 100644 --- a/src/map/lapack2flamec/f2c/c/dlansp.c +++ b/src/map/lapack2flamec/f2c/c/dlansp.c @@ -141,6 +141,7 @@ doublereal dlansp_(char *norm, char *uplo, integer *n, doublereal *ap, doublerea --work; --ap; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlanst.c b/src/map/lapack2flamec/f2c/c/dlanst.c index 461dd3256..ce17719d7 100644 --- a/src/map/lapack2flamec/f2c/c/dlanst.c +++ b/src/map/lapack2flamec/f2c/c/dlanst.c @@ -128,6 +128,7 @@ doublereal dlanst_(char *norm, integer *n, doublereal *d__, doublereal *e) --e; --d__; /* Function Body */ + anorm = 0.; if (*n <= 0) { anorm = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlansy.c b/src/map/lapack2flamec/f2c/c/dlansy.c index 7a3fd5e18..9446937a0 100644 --- a/src/map/lapack2flamec/f2c/c/dlansy.c +++ b/src/map/lapack2flamec/f2c/c/dlansy.c @@ -150,6 +150,7 @@ doublereal dlansy_(char *norm, char *uplo, integer *n, doublereal *a, integer *l a -= a_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlantb.c b/src/map/lapack2flamec/f2c/c/dlantb.c index ecf04a01f..c1a685a47 100644 --- a/src/map/lapack2flamec/f2c/c/dlantb.c +++ b/src/map/lapack2flamec/f2c/c/dlantb.c @@ -169,6 +169,7 @@ doublereal dlantb_(char *norm, char *uplo, char *diag, integer *n, integer *k, d ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlantp.c b/src/map/lapack2flamec/f2c/c/dlantp.c index 29977a7d9..2507e01e2 100644 --- a/src/map/lapack2flamec/f2c/c/dlantp.c +++ b/src/map/lapack2flamec/f2c/c/dlantp.c @@ -152,6 +152,7 @@ doublereal dlantp_(char *norm, char *uplo, char *diag, integer *n, doublereal *a --work; --ap; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlantr.c b/src/map/lapack2flamec/f2c/c/dlantr.c index 1ec9b5e1c..7fc96bd5b 100644 --- a/src/map/lapack2flamec/f2c/c/dlantr.c +++ b/src/map/lapack2flamec/f2c/c/dlantr.c @@ -170,6 +170,7 @@ doublereal dlantr_(char *norm, char *uplo, char *diag, integer *m, integer *n, d a -= a_offset; --work; /* Function Body */ + value = 0.; if (fla_min(*m,*n) == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp.c b/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp.c index 0e2a48394..44193550d 100644 --- a/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp.c +++ b/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp.c @@ -152,7 +152,7 @@ int dlaorhr_col_getrfnp_(integer *m, integer *n, doublereal *a, integer *lda, do int dlaorhr_col_getrfnp2_(integer *, integer *, doublereal *, integer *, doublereal *, integer *), dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer iinfo; extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -197,7 +197,7 @@ int dlaorhr_col_getrfnp_(integer *m, integer *n, doublereal *a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DLAORHR_COL_GETRFNP", &i__1); + xerbla_("DLAORHR_COL_GETRFNP", &i__1, (ftnlen)19); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp2.c b/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp2.c index 7376ca309..0cc0c687b 100644 --- a/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp2.c +++ b/src/map/lapack2flamec/f2c/c/dlaorhr_col_getrfnp2.c @@ -179,7 +179,7 @@ int dlaorhr_col_getrfnp2_(integer *m, integer *n, doublereal *a, integer *lda, d int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -223,7 +223,7 @@ int dlaorhr_col_getrfnp2_(integer *m, integer *n, doublereal *a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DLAORHR_COL_GETRFNP2", &i__1); + xerbla_("DLAORHR_COL_GETRFNP2", &i__1, (ftnlen)20); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlapy2.c b/src/map/lapack2flamec/f2c/c/dlapy2.c index fe1d19a4d..3c586aacf 100644 --- a/src/map/lapack2flamec/f2c/c/dlapy2.c +++ b/src/map/lapack2flamec/f2c/c/dlapy2.c @@ -77,6 +77,7 @@ doublereal dlapy2_(doublereal *x, doublereal *y) /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + ret_val = 0; x_is_nan__ = (*x != *x); y_is_nan__ = (*y != *y); if (r_once) diff --git a/src/map/lapack2flamec/f2c/c/dlaqp2.c b/src/map/lapack2flamec/f2c/c/dlaqp2.c index 5f61ca650..960149bf8 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqp2.c +++ b/src/map/lapack2flamec/f2c/c/dlaqp2.c @@ -206,7 +206,6 @@ int dlaqp2_(integer *m, integer *n, integer *offset, doublereal *a, integer *lda i__2 = *n - i__ + 1; #ifdef FLA_ENABLE_AMD_OPT /* Inline IDAMAX for small sizes (<= 128) */ - integer idmax = 1; if(i__2 <= FLA_IDAMAX_INLINE_SMALL_THRESH) { pvt = i__ - 1 + fla_idamax(&i__2, &vn1[i__], &c__1); diff --git a/src/map/lapack2flamec/f2c/c/dlaqr0.c b/src/map/lapack2flamec/f2c/c/dlaqr0.c index 6bff2e025..c217045f3 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqr0.c +++ b/src/map/lapack2flamec/f2c/c/dlaqr0.c @@ -328,6 +328,7 @@ int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlaqr4.c b/src/map/lapack2flamec/f2c/c/dlaqr4.c index 9b8e1d475..cdb8fdb2a 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqr4.c +++ b/src/map/lapack2flamec/f2c/c/dlaqr4.c @@ -336,6 +336,7 @@ int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlaqz0.c b/src/map/lapack2flamec/f2c/c/dlaqz0.c index 8f1068305..b892b89b3 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqz0.c +++ b/src/map/lapack2flamec/f2c/c/dlaqz0.c @@ -316,8 +316,6 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in double sqrt(doublereal); /* Local variables */ integer aed_info__; - extern /* Subroutine */ - int f90_cycle_(void); integer shiftpos, lworkreq, i__, k; doublereal c1; integer k2; @@ -349,7 +347,7 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; extern /* Subroutine */ int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); @@ -361,8 +359,6 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in integer iwantq, iwants, istart; doublereal smlnum; integer istopm, iwantz, istart2; - extern /* Subroutine */ - int f90_exit_(void); logical ilschur; integer nshifts, istartm; /* Arguments */ @@ -388,6 +384,7 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in z__ -= z_offset; --work; /* Function Body */ + eshift = 0.; if (lsame_(wants, "E")) { ilschur = FALSE_; @@ -485,7 +482,7 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in if (*info != 0) { i__1 = -(*info); - xerbla_("DLAQZ0", &i__1); + xerbla_("DLAQZ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -557,7 +554,7 @@ int dlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in } if (*info != 0) { - xerbla_("DLAQZ0", info); + xerbla_("DLAQZ0", info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaqz3.c b/src/map/lapack2flamec/f2c/c/dlaqz3.c index 6107d8430..c8bf52442 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqz3.c +++ b/src/map/lapack2flamec/f2c/c/dlaqz3.c @@ -261,7 +261,7 @@ int dlaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; extern /* Subroutine */ int dtgexc_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); @@ -345,7 +345,7 @@ int dlaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DLAQZ3", &i__1); + xerbla_("DLAQZ3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlaqz4.c b/src/map/lapack2flamec/f2c/c/dlaqz4.c index 259d6875a..e2d4d5194 100644 --- a/src/map/lapack2flamec/f2c/c/dlaqz4.c +++ b/src/map/lapack2flamec/f2c/c/dlaqz4.c @@ -218,7 +218,7 @@ int dlaqz4_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlaqz1_(doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlaqz2_(logical *, logical *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); integer nblock; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlacpy_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlacpy_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); integer ishift, istopb, swidth, istopm, sheight, istartb, istartm; /* Function arguments */ /* Parameters */ @@ -267,7 +267,7 @@ int dlaqz4_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DLAQZ4", &i__1); + xerbla_("DLAQZ4", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlarfg.c b/src/map/lapack2flamec/f2c/c/dlarfg.c index c4f49e162..387545d4a 100644 --- a/src/map/lapack2flamec/f2c/c/dlarfg.c +++ b/src/map/lapack2flamec/f2c/c/dlarfg.c @@ -1,7 +1,11 @@ /* ../netlib/dlarfg.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ + +/* + Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ + #include "FLA_f2c.h" /* > \brief \b DLARFG generates an elementary reflector (Householder matrix). */ -static integer c__1 = 1; /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ /* http://www.netlib.org/lapack/explore-html/ */ @@ -110,7 +114,9 @@ int dlarfg_(integer *n, doublereal *alpha, doublereal *x, integer *incx, doubler int dscal_(integer *, doublereal *, doublereal *, integer *); doublereal xnorm; extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); +#if FLA_ENABLE_AMD_OPT extern int fla_dscal(integer *n, doublereal *da, doublereal *dx, integer *incx); +#endif static TLS_CLASS_SPEC integer r_once = 1; static TLS_CLASS_SPEC doublereal safmin, rsafmn; /* -- LAPACK auxiliary routine (version 3.8.0) -- */ @@ -190,7 +196,7 @@ int dlarfg_(integer *n, doublereal *alpha, doublereal *x, integer *incx, doubler i__1 = *n - 1; d__1 = 1. / (*alpha - beta); -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT /* Inline DSCAL for small sizes */ fla_dscal(&i__1, &d__1, &x[1], incx); #else diff --git a/src/map/lapack2flamec/f2c/c/dlarrd.c b/src/map/lapack2flamec/f2c/c/dlarrd.c index 07a1e8374..2470a57e5 100644 --- a/src/map/lapack2flamec/f2c/c/dlarrd.c +++ b/src/map/lapack2flamec/f2c/c/dlarrd.c @@ -391,6 +391,8 @@ int dlarrd_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu --gers; /* Function Body */ *info = 0; + wul = 0.; + wlu = 0.; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlarre.c b/src/map/lapack2flamec/f2c/c/dlarre.c index 95f42464a..c27c26ff2 100644 --- a/src/map/lapack2flamec/f2c/c/dlarre.c +++ b/src/map/lapack2flamec/f2c/c/dlarre.c @@ -384,6 +384,9 @@ int dlarre_(char *range, integer *n, doublereal *vl, doublereal *vu, integer *il --d__; /* Function Body */ *info = 0; + wend = 0; + mb = 0; + irange = 0; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlarrf.c b/src/map/lapack2flamec/f2c/c/dlarrf.c index 76fd1538f..d8b2cb174 100644 --- a/src/map/lapack2flamec/f2c/c/dlarrf.c +++ b/src/map/lapack2flamec/f2c/c/dlarrf.c @@ -237,6 +237,7 @@ int dlarrf_(integer *n, doublereal *d__, doublereal *l, doublereal *ld, integer --d__; /* Function Body */ *info = 0; + indx = 0; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlarrv.c b/src/map/lapack2flamec/f2c/c/dlarrv.c index a64c564f7..4da830a5d 100644 --- a/src/map/lapack2flamec/f2c/c/dlarrv.c +++ b/src/map/lapack2flamec/f2c/c/dlarrv.c @@ -299,7 +299,6 @@ int dlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler doublereal ztz; integer iend, jblk; doublereal lgap; - integer done; doublereal rgap, left; integer wend, iter; doublereal bstw; @@ -464,8 +463,6 @@ int dlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler /* entries is contained in the interval IBEGIN:IEND. */ /* Remark that if k eigenpairs are desired, then the eigenvectors */ /* are stored in k contiguous columns of Z. */ - /* DONE is the number of eigenvectors already computed */ - done = 0; ibegin = 1; wbegin = 1; i__1 = iblock[*m]; @@ -524,7 +521,6 @@ int dlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler /* This is for a 1x1 block */ if (ibegin == iend) { - ++done; z__[ibegin + wbegin * z_dim1] = 1.; isuppz[(wbegin << 1) - 1] = ibegin; isuppz[wbegin * 2] = ibegin; @@ -866,7 +862,6 @@ int dlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler i__4 = windex + 1; windpl = fla_min(i__4,*m); lambda = work[windex]; - ++done; /* Check if eigenvector computation is to be skipped */ if (windex < *dol || windex > *dou) { diff --git a/src/map/lapack2flamec/f2c/c/dlartg.c b/src/map/lapack2flamec/f2c/c/dlartg.c index d97891bfa..8537fcb61 100644 --- a/src/map/lapack2flamec/f2c/c/dlartg.c +++ b/src/map/lapack2flamec/f2c/c/dlartg.c @@ -1,6 +1,100 @@ /* dlartg.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +/* > \brief \b DLARTG generates a plane rotation with real cosine and real sine. */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE DLARTG( F, G, C, S, R ) */ +/* .. Scalar Arguments .. */ +/* REAL(wp) C, F, G, R, S */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > DLARTG generates a plane rotation so that */ +/* > */ +/* > [ C S ] . [ F ] = [ R ] */ +/* > [ -S C ] [ G ] [ 0 ] */ +/* > */ +/* > where C**2 + S**2 = 1. */ +/* > */ +/* > The mathematical formulas used for C and S are */ +/* > R = sign(F) * sqrt(F**2 + G**2) */ +/* > C = F / R */ +/* > S = G / R */ +/* > Hence C >= 0. The algorithm used to compute these quantities */ +/* > incorporates scaling to avoid overflow or underflow in computing the */ +/* > square root of the sum of squares. */ +/* > */ +/* > This version is discontinuous in R at F = 0 but it returns the same */ +/* > C and S as ZLARTG for complex inputs (F,0) and (G,0). */ +/* > */ +/* > This is a more accurate version of the BLAS1 routine DROTG, */ +/* > with the following other differences: */ +/* > F and G are unchanged on return. */ +/* > If G=0, then C=1 and S=0. */ +/* > If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any */ +/* > floating point operations (saves work in DBDSQR when */ +/* > there are zeros on the diagonal). */ +/* > */ +/* > Below, wp=>dp stands for double precision from LA_CONSTANTS module. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] F */ +/* > \verbatim */ +/* > F is REAL(wp) */ +/* > The first component of vector to be rotated. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] G */ +/* > \verbatim */ +/* > G is REAL(wp) */ +/* > The second component of vector to be rotated. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] C */ +/* > \verbatim */ +/* > C is REAL(wp) */ +/* > The cosine of the rotation. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] S */ +/* > \verbatim */ +/* > S is REAL(wp) */ +/* > The sine of the rotation. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] R */ +/* > \verbatim */ +/* > R is REAL(wp) */ +/* > The nonzero component of the rotated vector. */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Edward Anderson, Lockheed Martin */ +/* > \date July 2016 */ +/* > \ingroup OTHERauxiliary */ +/* > \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 */ +/* > */ +/* > \endverbatim */ static doublereal c_b2 = 1.; /* Subroutine */ int dlartg_(doublereal *f, doublereal *g, doublereal *c__, doublereal *s, doublereal *r__) @@ -13,11 +107,10 @@ int dlartg_(doublereal *f, doublereal *g, doublereal *c__, doublereal *s, double doublereal d__, u, f1, g1, fs, gs, rtmin, rtmax, safmin, safmax; doublereal d__1, d__2, d__3; /* ...Translated by Pacific-Sierra Research vf90 Personal 3.4N3 05:19:29 1/25/23 */ - /* ...Switches: */ - /* .. */ - /* .. Local Scalars .. */ - /* .. */ - /* .. Intrinsic Functions .. */ + /* -- LAPACK auxiliary routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* February 2021 */ /* .. */ /* .. Constants .. */ safmin = 2.2250738585072014e-308; diff --git a/src/map/lapack2flamec/f2c/c/dlaruv.c b/src/map/lapack2flamec/f2c/c/dlaruv.c index 80c4cc1fc..8ebe73471 100644 --- a/src/map/lapack2flamec/f2c/c/dlaruv.c +++ b/src/map/lapack2flamec/f2c/c/dlaruv.c @@ -126,6 +126,10 @@ int dlaruv_(integer *iseed, integer *n, doublereal *x) i3 = iseed[3]; i4 = iseed[4]; i__1 = fla_min(*n,128); + it1 = 0; + it2 = 0; + it3 = 0; + it4 = 0; for (i__ = 1; i__ <= i__1; ++i__) diff --git a/src/map/lapack2flamec/f2c/c/dlarzb.c b/src/map/lapack2flamec/f2c/c/dlarzb.c index 6b2a831d3..8d56fa5d5 100644 --- a/src/map/lapack2flamec/f2c/c/dlarzb.c +++ b/src/map/lapack2flamec/f2c/c/dlarzb.c @@ -186,7 +186,7 @@ int dlarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); char transt[1]; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -239,7 +239,7 @@ int dlarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in if (info != 0) { i__1 = -info; - xerbla_("DLARZB", &i__1); + xerbla_("DLARZB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlarzt.c b/src/map/lapack2flamec/f2c/c/dlarzt.c index d766d3b07..8d625c503 100644 --- a/src/map/lapack2flamec/f2c/c/dlarzt.c +++ b/src/map/lapack2flamec/f2c/c/dlarzt.c @@ -188,7 +188,7 @@ int dlarzt_(char *direct, char *storev, integer *n, integer * k, doublereal *v, integer i__, j, info; extern logical lsame_(char *, char *); extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -229,7 +229,7 @@ int dlarzt_(char *direct, char *storev, integer *n, integer * k, doublereal *v, if (info != 0) { i__1 = -info; - xerbla_("DLARZT", &i__1); + xerbla_("DLARZT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlascl.c b/src/map/lapack2flamec/f2c/c/dlascl.c index 815f7f7d1..f70e093f4 100644 --- a/src/map/lapack2flamec/f2c/c/dlascl.c +++ b/src/map/lapack2flamec/f2c/c/dlascl.c @@ -149,7 +149,7 @@ int dlascl_(char *type__, integer *kl, integer *ku, doublereal *cfrom, doublerea doublereal cfromc; extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK auxiliary routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -258,7 +258,7 @@ int dlascl_(char *type__, integer *kl, integer *ku, doublereal *cfrom, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DLASCL", &i__1); + xerbla_("DLASCL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd0.c b/src/map/lapack2flamec/f2c/c/dlasd0.c index 7887f0035..d1ff34799 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd0.c +++ b/src/map/lapack2flamec/f2c/c/dlasd0.c @@ -157,7 +157,7 @@ int dlasd0_(integer *n, integer *sqre, doublereal *d__, doublereal *e, doublerea doublereal alpha; integer inode, ndiml, idxqc, ndimr, itemp, sqrei; extern /* Subroutine */ - int dlasd1_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_( char *, integer *); + int dlasd1_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -210,7 +210,7 @@ int dlasd0_(integer *n, integer *sqre, doublereal *d__, doublereal *e, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD0", &i__1); + xerbla_("DLASD0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd1.c b/src/map/lapack2flamec/f2c/c/dlasd1.c index 040fd55ff..c6c125a0a 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd1.c +++ b/src/map/lapack2flamec/f2c/c/dlasd1.c @@ -211,7 +211,7 @@ int dlasd1_(integer *nl, integer *nr, integer *sqre, doublereal *d__, doublereal int dlasd2_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, integer *, integer *, integer *), dlasd3_( integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *); integer isigma; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal orgnrm; integer coltyp; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ @@ -261,7 +261,7 @@ int dlasd1_(integer *nl, integer *nr, integer *sqre, doublereal *d__, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD1", &i__1); + xerbla_("DLASD1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd2.c b/src/map/lapack2flamec/f2c/c/dlasd2.c index 0cd70fd5c..9bcc6c5e2 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd2.c +++ b/src/map/lapack2flamec/f2c/c/dlasd2.c @@ -286,7 +286,7 @@ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__ integer jprev; extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal hlftol; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -334,6 +334,7 @@ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__ --coltyp; /* Function Body */ *info = 0; + jprev = 0; if (*nl < 1) { *info = -1; @@ -367,7 +368,7 @@ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__ if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD2", &i__1); + xerbla_("DLASD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd3.c b/src/map/lapack2flamec/f2c/c/dlasd3.c index 9582a240c..2ca900e17 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd3.c +++ b/src/map/lapack2flamec/f2c/c/dlasd3.c @@ -239,7 +239,7 @@ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__ integer ktemp; extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -327,7 +327,7 @@ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__ if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD3", &i__1); + xerbla_("DLASD3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd6.c b/src/map/lapack2flamec/f2c/c/dlasd6.c index 720cc0e48..0a1fe7b85 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd6.c +++ b/src/map/lapack2flamec/f2c/c/dlasd6.c @@ -317,7 +317,7 @@ int dlasd6_(integer *icompq, integer *nl, integer *nr, integer *sqre, doublereal int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlasd7_(integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlasd8_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *); integer isigma; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal orgnrm; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -389,7 +389,7 @@ int dlasd6_(integer *icompq, integer *nl, integer *nr, integer *sqre, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD6", &i__1); + xerbla_("DLASD6", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd7.c b/src/map/lapack2flamec/f2c/c/dlasd7.c index a428666ac..b815594e7 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd7.c +++ b/src/map/lapack2flamec/f2c/c/dlasd7.c @@ -289,7 +289,7 @@ int dlasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k integer jprev; extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal hlftol; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -333,6 +333,7 @@ int dlasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k givnum -= givnum_offset; /* Function Body */ *info = 0; + jprev = 0; n = *nl + *nr + 1; m = n + *sqre; if (*icompq < 0 || *icompq > 1) @@ -362,7 +363,7 @@ int dlasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD7", &i__1); + xerbla_("DLASD7", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasd8.c b/src/map/lapack2flamec/f2c/c/dlasd8.c index 6551f4ed3..609001b98 100644 --- a/src/map/lapack2flamec/f2c/c/dlasd8.c +++ b/src/map/lapack2flamec/f2c/c/dlasd8.c @@ -177,7 +177,7 @@ int dlasd8_(integer *icompq, integer *k, doublereal *d__, doublereal *z__, doubl int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal dsigjp; /* -- LAPACK auxiliary routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -213,6 +213,7 @@ int dlasd8_(integer *icompq, integer *k, doublereal *d__, doublereal *z__, doubl --work; /* Function Body */ *info = 0; + difrj = 0.; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -228,7 +229,7 @@ int dlasd8_(integer *icompq, integer *k, doublereal *d__, doublereal *z__, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DLASD8", &i__1); + xerbla_("DLASD8", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasda.c b/src/map/lapack2flamec/f2c/c/dlasda.c index 4952eaeaa..629f8e5e6 100644 --- a/src/map/lapack2flamec/f2c/c/dlasda.c +++ b/src/map/lapack2flamec/f2c/c/dlasda.c @@ -286,7 +286,7 @@ int dlasda_(integer *icompq, integer *smlsiz, integer *n, integer *sqre, doubler int dlasd6_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); integer nwork1, nwork2; extern /* Subroutine */ - int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), dlaset_( char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), dlaset_( char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer smlszp; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -370,7 +370,7 @@ int dlasda_(integer *icompq, integer *smlsiz, integer *n, integer *sqre, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DLASDA", &i__1); + xerbla_("DLASDA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasdq.c b/src/map/lapack2flamec/f2c/c/dlasdq.c index 96d9e29bd..88fdd87b3 100644 --- a/src/map/lapack2flamec/f2c/c/dlasdq.c +++ b/src/map/lapack2flamec/f2c/c/dlasdq.c @@ -215,7 +215,7 @@ int dlasdq_(char *uplo, integer *sqre, integer *n, integer * ncvt, integer *nru, int dlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); integer iuplo; extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical rotate; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -301,7 +301,7 @@ int dlasdq_(char *uplo, integer *sqre, integer *n, integer * ncvt, integer *nru, if (*info != 0) { i__1 = -(*info); - xerbla_("DLASDQ", &i__1); + xerbla_("DLASDQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasq1.c b/src/map/lapack2flamec/f2c/c/dlasq1.c index 4ddc84a40..ae922545a 100644 --- a/src/map/lapack2flamec/f2c/c/dlasq1.c +++ b/src/map/lapack2flamec/f2c/c/dlasq1.c @@ -125,7 +125,7 @@ int dlasq1_(integer *n, doublereal *d__, doublereal *e, doublereal *work, intege int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dlasrt_( char *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlasrt_( char *, integer *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,7 +156,7 @@ int dlasq1_(integer *n, doublereal *d__, doublereal *e, doublereal *work, intege { *info = -1; i__1 = -(*info); - xerbla_("DLASQ1", &i__1); + xerbla_("DLASQ1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasq2.c b/src/map/lapack2flamec/f2c/c/dlasq2.c index 65cdaec44..93d84c96f 100644 --- a/src/map/lapack2flamec/f2c/c/dlasq2.c +++ b/src/map/lapack2flamec/f2c/c/dlasq2.c @@ -141,7 +141,7 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) integer iwhila, iwhilb; doublereal oldemn, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *, integer *); @@ -179,7 +179,7 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) if (*n < 0) { *info = -1; - xerbla_("DLASQ2", &c__1); + xerbla_("DLASQ2", &c__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -194,7 +194,7 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) if (z__[1] < 0.) { *info = -201; - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); } AOCL_DTL_TRACE_LOG_EXIT return 0; @@ -205,21 +205,21 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) if (z__[1] < 0.) { *info = -201; - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[2] < 0.) { *info = -202; - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[3] < 0.) { *info = -203; - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -266,14 +266,14 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) if (z__[k] < 0.) { *info = -(k + 200); - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[k + 1] < 0.) { *info = -(k + 201); - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -296,7 +296,7 @@ int dlasq2_(integer *n, doublereal *z__, integer *info) if (z__[(*n << 1) - 1] < 0.) { *info = -((*n << 1) + 199); - xerbla_("DLASQ2", &c__2); + xerbla_("DLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasq4.c b/src/map/lapack2flamec/f2c/c/dlasq4.c index fd8184b83..881725b8e 100644 --- a/src/map/lapack2flamec/f2c/c/dlasq4.c +++ b/src/map/lapack2flamec/f2c/c/dlasq4.c @@ -170,6 +170,7 @@ int dlasq4_(integer *i0, integer *n0, doublereal *z__, integer *pp, integer *n0i /* Parameter adjustments */ --z__; /* Function Body */ + s = 0.; if (*dmin__ <= 0.) { *tau = -(*dmin__); diff --git a/src/map/lapack2flamec/f2c/c/dlasr.c b/src/map/lapack2flamec/f2c/c/dlasr.c index 0dc919d8b..8d1d5e50d 100644 --- a/src/map/lapack2flamec/f2c/c/dlasr.c +++ b/src/map/lapack2flamec/f2c/c/dlasr.c @@ -197,7 +197,7 @@ int dlasr_(char *side, char *pivot, char *direct, integer *m, integer *n, double extern logical lsame_(char *, char *); doublereal ctemp, stemp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -253,7 +253,7 @@ int dlasr_(char *side, char *pivot, char *direct, integer *m, integer *n, double } if (info != 0) { - xerbla_("DLASR ", &info); + xerbla_("DLASR ", &info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasrt.c b/src/map/lapack2flamec/f2c/c/dlasrt.c index 2eb13f285..e05c30f3a 100644 --- a/src/map/lapack2flamec/f2c/c/dlasrt.c +++ b/src/map/lapack2flamec/f2c/c/dlasrt.c @@ -93,7 +93,7 @@ int dlasrt_(char *id, integer *n, doublereal *d__, integer * info) doublereal dmnmx; integer start; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer stkpnt; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -140,7 +140,7 @@ int dlasrt_(char *id, integer *n, doublereal *d__, integer * info) if (*info != 0) { i__1 = -(*info); - xerbla_("DLASRT", &i__1); + xerbla_("DLASRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlassq.c b/src/map/lapack2flamec/f2c/c/dlassq.c index 9fa2ba65e..c3a0fd37f 100644 --- a/src/map/lapack2flamec/f2c/c/dlassq.c +++ b/src/map/lapack2flamec/f2c/c/dlassq.c @@ -116,7 +116,7 @@ int dlassq_(integer *n, doublereal *x, integer *incx, doublereal *scl, doublerea AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dlassq inputs: n %" FLA_IS ", incx %" FLA_IS "",*n, *incx); /* System generated locals */ - integer i__1, i__2; + integer i__1; doublereal r__1, r__2; /* Builtin functions */ double pow_ri(doublereal *, doublereal *), sqrt(doublereal); diff --git a/src/map/lapack2flamec/f2c/c/dlaswlq.c b/src/map/lapack2flamec/f2c/c/dlaswlq.c index 4ada8af66..19d8224f9 100644 --- a/src/map/lapack2flamec/f2c/c/dlaswlq.c +++ b/src/map/lapack2flamec/f2c/c/dlaswlq.c @@ -166,7 +166,7 @@ int dlaswlq_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, i /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), dgelqt_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtplqt_( integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgelqt_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtplqt_( integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int dlaswlq_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DLASWLQ", &i__1); + xerbla_("DLASWLQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlasy2.c b/src/map/lapack2flamec/f2c/c/dlasy2.c index 4d7be65ab..dd3cd19a3 100644 --- a/src/map/lapack2flamec/f2c/c/dlasy2.c +++ b/src/map/lapack2flamec/f2c/c/dlasy2.c @@ -210,10 +210,10 @@ int dlasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, intege integer ipsv, jpsv; logical bswap; extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); + int dcopy_(const integer *, doublereal *, const integer *, doublereal *, const integer *), dswap_(const integer *, doublereal *, const integer *, doublereal *, const integer *); logical xswap; extern doublereal dlamch_(char *); - extern integer idamax_(integer *, doublereal *, integer *); + extern integer idamax_(const integer *, doublereal *, const integer *); doublereal smlnum; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -255,6 +255,8 @@ int dlasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, intege /* .. Executable Statements .. */ /* Do not check the input parameters for errors */ *info = 0; + jpsv = 0; + ipsv = 0; /* Quick return if possible */ if (*n1 == 0 || *n2 == 0) { diff --git a/src/map/lapack2flamec/f2c/c/dlasyf_rk.c b/src/map/lapack2flamec/f2c/c/dlasyf_rk.c index 98f51d9fa..d840515d7 100644 --- a/src/map/lapack2flamec/f2c/c/dlasyf_rk.c +++ b/src/map/lapack2flamec/f2c/c/dlasyf_rk.c @@ -314,6 +314,7 @@ int dlasyf_rk_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/dlasyf_rook.c b/src/map/lapack2flamec/f2c/c/dlasyf_rook.c index 826c39008..8d1fea1ca 100644 --- a/src/map/lapack2flamec/f2c/c/dlasyf_rook.c +++ b/src/map/lapack2flamec/f2c/c/dlasyf_rook.c @@ -232,6 +232,7 @@ int dlasyf_rook_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/dlatbs.c b/src/map/lapack2flamec/f2c/c/dlatbs.c index 343c9e752..a7aa12774 100644 --- a/src/map/lapack2flamec/f2c/c/dlatbs.c +++ b/src/map/lapack2flamec/f2c/c/dlatbs.c @@ -264,7 +264,7 @@ int dlatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical notran; integer jfirst; @@ -301,6 +301,7 @@ int dlatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -333,7 +334,7 @@ int dlatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DLATBS", &i__1); + xerbla_("DLATBS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlatps.c b/src/map/lapack2flamec/f2c/c/dlatps.c index 3e1dc22fd..b77b08e5a 100644 --- a/src/map/lapack2flamec/f2c/c/dlatps.c +++ b/src/map/lapack2flamec/f2c/c/dlatps.c @@ -252,7 +252,7 @@ int dlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical notran; integer jfirst; @@ -287,6 +287,7 @@ int dlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -311,7 +312,7 @@ int dlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DLATPS", &i__1); + xerbla_("DLATPS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlatrs.c b/src/map/lapack2flamec/f2c/c/dlatrs.c index a916edd79..64014bd29 100644 --- a/src/map/lapack2flamec/f2c/c/dlatrs.c +++ b/src/map/lapack2flamec/f2c/c/dlatrs.c @@ -259,7 +259,7 @@ int dlatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical notran; integer jfirst; @@ -295,6 +295,7 @@ int dlatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -323,7 +324,7 @@ int dlatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DLATRS", &i__1); + xerbla_("DLATRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlatrs3.c b/src/map/lapack2flamec/f2c/c/dlatrs3.c index 8adef20bd..d10fc4920 100644 --- a/src/map/lapack2flamec/f2c/c/dlatrs3.c +++ b/src/map/lapack2flamec/f2c/c/dlatrs3.c @@ -243,7 +243,7 @@ int dlatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int doublereal scaloc, scamin; extern doublereal dlarmm_(doublereal *, doublereal *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; extern /* Subroutine */ @@ -360,7 +360,7 @@ int dlatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int if (*info != 0) { i__1 = -(*info); - xerbla_("DLATRS3", &i__1); + xerbla_("DLATRS3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dlatsqr.c b/src/map/lapack2flamec/f2c/c/dlatsqr.c index b73ac1231..a4fadd190 100644 --- a/src/map/lapack2flamec/f2c/c/dlatsqr.c +++ b/src/map/lapack2flamec/f2c/c/dlatsqr.c @@ -168,7 +168,7 @@ int dlatsqr_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, i /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), dgeqrt_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpqrt_( integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgeqrt_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpqrt_( integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical lquery; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -233,7 +233,7 @@ int dlatsqr_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DLATSQR", &i__1); + xerbla_("DLATSQR", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dopmtr.c b/src/map/lapack2flamec/f2c/c/dopmtr.c index 0464d8b2e..2fb72241e 100644 --- a/src/map/lapack2flamec/f2c/c/dopmtr.c +++ b/src/map/lapack2flamec/f2c/c/dopmtr.c @@ -156,7 +156,7 @@ int dopmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doubler extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -227,7 +227,7 @@ int dopmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DOPMTR", &i__1); + xerbla_("DOPMTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb.c b/src/map/lapack2flamec/f2c/c/dorbdb.c index 66b027da9..450b5cb96 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb.c @@ -300,7 +300,7 @@ int dorbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, double int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dlarfgp_(integer *, doublereal *, doublereal *, integer *, doublereal *); @@ -445,7 +445,7 @@ int dorbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, double if (*info != 0) { i__1 = -(*info); - xerbla_("xORBDB", &i__1); + xerbla_("xORBDB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb1.c b/src/map/lapack2flamec/f2c/c/dorbdb1.c index 212ebe79b..2e9ecab9b 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb1.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb1.c @@ -212,7 +212,7 @@ int dorbdb1_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); integer ilarf, llarf; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dorbdb5_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -307,7 +307,7 @@ int dorbdb1_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB1", &i__1); + xerbla_("DORBDB1", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb2.c b/src/map/lapack2flamec/f2c/c/dorbdb2.c index 99b0b2859..b1f24e12f 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb2.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb2.c @@ -212,7 +212,7 @@ int dorbdb2_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); integer ilarf, llarf; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dorbdb5_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -307,7 +307,7 @@ int dorbdb2_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB2", &i__1); + xerbla_("DORBDB2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb3.c b/src/map/lapack2flamec/f2c/c/dorbdb3.c index 558f8d024..bd18cfdc2 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb3.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb3.c @@ -210,7 +210,7 @@ int dorbdb3_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); integer ilarf, llarf; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dorbdb5_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -305,7 +305,7 @@ int dorbdb3_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB3", &i__1); + xerbla_("DORBDB3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb4.c b/src/map/lapack2flamec/f2c/c/dorbdb4.c index e017d6956..99786bfdb 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb4.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb4.c @@ -223,7 +223,7 @@ int dorbdb4_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); integer ilarf, llarf; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int dorbdb5_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -320,7 +320,7 @@ int dorbdb4_(integer *m, integer *p, integer *q, doublereal * x11, integer *ldx1 if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB4", &i__1); + xerbla_("DORBDB4", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb5.c b/src/map/lapack2flamec/f2c/c/dorbdb5.c index 9ddf68f28..5582a0959 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb5.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb5.c @@ -151,7 +151,7 @@ int dorbdb5_(integer *m1, integer *m2, integer *n, doublereal *x1, integer *incx integer i__, j, childinfo; extern doublereal dnrm2_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), dorbdb6_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dorbdb6_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -220,7 +220,7 @@ int dorbdb5_(integer *m1, integer *m2, integer *n, doublereal *x1, integer *incx if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB5", &i__1); + xerbla_("DORBDB5", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorbdb6.c b/src/map/lapack2flamec/f2c/c/dorbdb6.c index c18429b03..b3740fdcc 100644 --- a/src/map/lapack2flamec/f2c/c/dorbdb6.c +++ b/src/map/lapack2flamec/f2c/c/dorbdb6.c @@ -165,7 +165,7 @@ int dorbdb6_(integer *m1, integer *m2, integer *n, doublereal *x1, integer *incx int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dlassq_( integer *, doublereal *, integer *, doublereal *, doublereal *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlassq_( integer *, doublereal *, integer *, doublereal *, doublereal *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -233,7 +233,7 @@ int dorbdb6_(integer *m1, integer *m2, integer *n, doublereal *x1, integer *incx if (*info != 0) { i__1 = -(*info); - xerbla_("DORBDB6", &i__1); + xerbla_("DORBDB6", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorg2l.c b/src/map/lapack2flamec/f2c/c/dorg2l.c index 982aa9b25..cf6960633 100644 --- a/src/map/lapack2flamec/f2c/c/dorg2l.c +++ b/src/map/lapack2flamec/f2c/c/dorg2l.c @@ -112,7 +112,7 @@ int dorg2l_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -159,7 +159,7 @@ int dorg2l_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORG2L", &i__1); + xerbla_("DORG2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorgql.c b/src/map/lapack2flamec/f2c/c/dorgql.c index c37612bc0..c0dec5718 100644 --- a/src/map/lapack2flamec/f2c/c/dorgql.c +++ b/src/map/lapack2flamec/f2c/c/dorgql.c @@ -129,7 +129,7 @@ int dorgql_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do /* Local variables */ integer i__, j, l, ib, nb, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int dorg2l_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorg2l_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -162,6 +162,7 @@ int dorgql_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -199,7 +200,7 @@ int dorgql_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORGQL", &i__1); + xerbla_("DORGQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorgr2.c b/src/map/lapack2flamec/f2c/c/dorgr2.c index abd36bc3d..b1011dfd1 100644 --- a/src/map/lapack2flamec/f2c/c/dorgr2.c +++ b/src/map/lapack2flamec/f2c/c/dorgr2.c @@ -110,7 +110,7 @@ int dorgr2_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -157,7 +157,7 @@ int dorgr2_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORGR2", &i__1); + xerbla_("DORGR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorgrq.c b/src/map/lapack2flamec/f2c/c/dorgrq.c index c32c1d675..da2959421 100644 --- a/src/map/lapack2flamec/f2c/c/dorgrq.c +++ b/src/map/lapack2flamec/f2c/c/dorgrq.c @@ -129,7 +129,7 @@ int dorgrq_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do /* Local variables */ integer i__, j, l, ib, nb, ii, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int dorgr2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorgr2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -162,6 +162,7 @@ int dorgrq_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do --work; /* Function Body */ *info = 0; + nb = 0; lquery = *lwork == -1; if (*m < 0) { @@ -199,7 +200,7 @@ int dorgrq_(integer *m, integer *n, integer *k, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DORGRQ", &i__1); + xerbla_("DORGRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorgtsqr.c b/src/map/lapack2flamec/f2c/c/dorgtsqr.c index 20221aa53..30f0d7ddf 100644 --- a/src/map/lapack2flamec/f2c/c/dorgtsqr.c +++ b/src/map/lapack2flamec/f2c/c/dorgtsqr.c @@ -176,7 +176,7 @@ int dorgtsqr_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, int dlamtsqr_(char *, char *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); integer lworkopt, j, lc, lw, ldc, iinfo; extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer nblocal; /* -- LAPACK computational routine (version 3.9.0) -- */ @@ -269,7 +269,7 @@ int dorgtsqr_(integer *m, integer *n, integer *mb, integer * nb, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DORGTSQR", &i__1); + xerbla_("DORGTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorgtsqr_row.c b/src/map/lapack2flamec/f2c/c/dorgtsqr_row.c index 30bbc6877..eca3cd49a 100644 --- a/src/map/lapack2flamec/f2c/c/dorgtsqr_row.c +++ b/src/map/lapack2flamec/f2c/c/dorgtsqr_row.c @@ -193,7 +193,7 @@ int dorgtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, doublereal * doublereal dummy[1] /* was [1][1] */ ; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer nblocal, kb_last__; /* -- LAPACK computational routine -- */ @@ -274,7 +274,7 @@ int dorgtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DORGTSQR_ROW", &i__1); + xerbla_("DORGTSQR_ROW", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorhr_col.c b/src/map/lapack2flamec/f2c/c/dorhr_col.c index 5c2fe5e7e..0d53ad9ac 100644 --- a/src/map/lapack2flamec/f2c/c/dorhr_col.c +++ b/src/map/lapack2flamec/f2c/c/dorhr_col.c @@ -272,7 +272,7 @@ int dorhr_col_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, int dlaorhr_col_getrfnp_(integer *, integer *, doublereal *, integer *, doublereal *, integer *), dscal_(integer *, doublereal *, doublereal *, integer *); integer iinfo; extern /* Subroutine */ - int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jbtemp1, jbtemp2; /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -333,7 +333,7 @@ int dorhr_col_(integer *m, integer *n, integer *nb, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DORHR_COL", &i__1); + xerbla_("DORHR_COL", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorm22.c b/src/map/lapack2flamec/f2c/c/dorm22.c index 78a488bf9..78d6cb44a 100644 --- a/src/map/lapack2flamec/f2c/c/dorm22.c +++ b/src/map/lapack2flamec/f2c/c/dorm22.c @@ -168,7 +168,7 @@ int dorm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlacpy_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlacpy_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork, lwkopt; logical lquery; @@ -265,7 +265,7 @@ int dorm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DORM22", &i__1); + xerbla_("DORM22", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dorm2l.c b/src/map/lapack2flamec/f2c/c/dorm2l.c index 5594da34b..386138f0b 100644 --- a/src/map/lapack2flamec/f2c/c/dorm2l.c +++ b/src/map/lapack2flamec/f2c/c/dorm2l.c @@ -162,7 +162,7 @@ int dorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doubler int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -238,7 +238,7 @@ int dorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DORM2L", &i__1); + xerbla_("DORM2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dormql.c b/src/map/lapack2flamec/f2c/c/dormql.c index c6fd1f1be..235e80bd5 100644 --- a/src/map/lapack2flamec/f2c/c/dormql.c +++ b/src/map/lapack2flamec/f2c/c/dormql.c @@ -168,8 +168,7 @@ int dormql_(char *side, char *trans, integer *m, integer *n, integer *k, doubler AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormql inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -180,7 +179,7 @@ int dormql_(char *side, char *trans, integer *m, integer *n, integer *k, doubler extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int dorm2l_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorm2l_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -217,6 +216,7 @@ int dormql_(char *side, char *trans, integer *m, integer *n, integer *k, doubler --work; /* Function Body */ *info = 0; + nb = 0; left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; @@ -283,7 +283,7 @@ int dormql_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DORMQL", &i__1); + xerbla_("DORMQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dormr2.c b/src/map/lapack2flamec/f2c/c/dormr2.c index 124e66cdd..2f493448d 100644 --- a/src/map/lapack2flamec/f2c/c/dormr2.c +++ b/src/map/lapack2flamec/f2c/c/dormr2.c @@ -159,7 +159,7 @@ int dormr2_(char *side, char *trans, integer *m, integer *n, integer *k, doubler int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -235,7 +235,7 @@ int dormr2_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DORMR2", &i__1); + xerbla_("DORMR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dormr3.c b/src/map/lapack2flamec/f2c/c/dormr3.c index d45379f38..99e02f71d 100644 --- a/src/map/lapack2flamec/f2c/c/dormr3.c +++ b/src/map/lapack2flamec/f2c/c/dormr3.c @@ -174,7 +174,7 @@ int dormr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int dlarz_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarz_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -252,7 +252,7 @@ int dormr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DORMR3", &i__1); + xerbla_("DORMR3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dormrq.c b/src/map/lapack2flamec/f2c/c/dormrq.c index f6c9496ca..b34494233 100644 --- a/src/map/lapack2flamec/f2c/c/dormrq.c +++ b/src/map/lapack2flamec/f2c/c/dormrq.c @@ -167,8 +167,7 @@ int dormrq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormrq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -179,7 +178,7 @@ int dormrq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dormr2_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -218,6 +217,7 @@ int dormrq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler --work; /* Function Body */ *info = 0; + nb = 0; left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; @@ -284,7 +284,7 @@ int dormrq_(char *side, char *trans, integer *m, integer *n, integer *k, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DORMRQ", &i__1); + xerbla_("DORMRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dormrz.c b/src/map/lapack2flamec/f2c/c/dormrz.c index e2cdf35c5..39a0ae189 100644 --- a/src/map/lapack2flamec/f2c/c/dormrz.c +++ b/src/map/lapack2flamec/f2c/c/dormrz.c @@ -186,19 +186,17 @@ int dormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dormrz inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", l %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "",*side, *trans, *m, *n, *k, *l, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ - /* Local variables */ integer i__, i1, i2, i3, ib, ic, ja, jc, nb, mi, ni, nq, nw, iwt; logical left; extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int dormr3_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dormr3_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlarzb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarzt_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); @@ -239,6 +237,7 @@ int dormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer --work; /* Function Body */ *info = 0; + nb = 0; left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; @@ -309,7 +308,7 @@ int dormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DORMRZ", &i__1); + xerbla_("DORMRZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbcon.c b/src/map/lapack2flamec/f2c/c/dpbcon.c index d9e02eda6..b9918fac6 100644 --- a/src/map/lapack2flamec/f2c/c/dpbcon.c +++ b/src/map/lapack2flamec/f2c/c/dpbcon.c @@ -145,7 +145,7 @@ int dpbcon_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, int dlatbs_(char *, char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; char normin[1]; doublereal smlnum; @@ -204,7 +204,7 @@ int dpbcon_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBCON", &i__1); + xerbla_("DPBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbequ.c b/src/map/lapack2flamec/f2c/c/dpbequ.c index e69aed4d3..17d5bea03 100644 --- a/src/map/lapack2flamec/f2c/c/dpbequ.c +++ b/src/map/lapack2flamec/f2c/c/dpbequ.c @@ -132,7 +132,7 @@ int dpbequ_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -181,7 +181,7 @@ int dpbequ_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBEQU", &i__1); + xerbla_("DPBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbrfs.c b/src/map/lapack2flamec/f2c/c/dpbrfs.c index 9f9a0339a..fe8a1994f 100644 --- a/src/map/lapack2flamec/f2c/c/dpbrfs.c +++ b/src/map/lapack2flamec/f2c/c/dpbrfs.c @@ -204,7 +204,7 @@ int dpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dpbtrs_( char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbtrs_( char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); doublereal lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -284,7 +284,7 @@ int dpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBRFS", &i__1); + xerbla_("DPBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbstf.c b/src/map/lapack2flamec/f2c/c/dpbstf.c index 7d24c9763..b1aa715cd 100644 --- a/src/map/lapack2flamec/f2c/c/dpbstf.c +++ b/src/map/lapack2flamec/f2c/c/dpbstf.c @@ -162,7 +162,7 @@ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -210,7 +210,7 @@ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBSTF", &i__1); + xerbla_("DPBSTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbsv.c b/src/map/lapack2flamec/f2c/c/dpbsv.c index 24291d72e..51df787ea 100644 --- a/src/map/lapack2flamec/f2c/c/dpbsv.c +++ b/src/map/lapack2flamec/f2c/c/dpbsv.c @@ -161,7 +161,7 @@ int dpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dpbtrf_( char *, integer *, integer *, doublereal *, integer *, integer *), dpbtrs_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbtrf_( char *, integer *, integer *, doublereal *, integer *, integer *), dpbtrs_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -215,7 +215,7 @@ int dpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBSV ", &i__1); + xerbla_("DPBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbsvx.c b/src/map/lapack2flamec/f2c/c/dpbsvx.c index 8edc6557a..579179b2b 100644 --- a/src/map/lapack2flamec/f2c/c/dpbsvx.c +++ b/src/map/lapack2flamec/f2c/c/dpbsvx.c @@ -354,7 +354,7 @@ int dpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub int dpbcon_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlaqsb_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dpbequ_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbequ_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal bignum; extern /* Subroutine */ int dpbrfs_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dpbtrf_(char *, integer *, integer *, doublereal *, integer *, integer *); @@ -405,6 +405,8 @@ int dpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); upper = lsame_(uplo, "U"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -498,7 +500,7 @@ int dpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DPBSVX", &i__1); + xerbla_("DPBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbtf2.c b/src/map/lapack2flamec/f2c/c/dpbtf2.c index 7ec056807..d866fcd87 100644 --- a/src/map/lapack2flamec/f2c/c/dpbtf2.c +++ b/src/map/lapack2flamec/f2c/c/dpbtf2.c @@ -150,7 +150,7 @@ int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -198,7 +198,7 @@ int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBTF2", &i__1); + xerbla_("DPBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbtrf.c b/src/map/lapack2flamec/f2c/c/dpbtrf.c index 213bf4cd8..9403f86e8 100644 --- a/src/map/lapack2flamec/f2c/c/dpbtrf.c +++ b/src/map/lapack2flamec/f2c/c/dpbtrf.c @@ -148,7 +148,7 @@ int dpbtrf_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsyrk_( char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), dpbtf2_(char *, integer *, integer *, doublereal *, integer *, integer *), dpotf2_(char *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsyrk_( char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), dpbtf2_(char *, integer *, integer *, doublereal *, integer *, integer *), dpotf2_(char *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -198,7 +198,7 @@ int dpbtrf_(char *uplo, integer *n, integer *kd, doublereal * ab, integer *ldab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBTRF", &i__1); + xerbla_("DPBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpbtrs.c b/src/map/lapack2flamec/f2c/c/dpbtrs.c index dea6efe0f..556bbae46 100644 --- a/src/map/lapack2flamec/f2c/c/dpbtrs.c +++ b/src/map/lapack2flamec/f2c/c/dpbtrs.c @@ -124,7 +124,7 @@ int dpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, int dtbsv_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -181,7 +181,7 @@ int dpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublereal *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("DPBTRS", &i__1); + xerbla_("DPBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpftrf.c b/src/map/lapack2flamec/f2c/c/dpftrf.c index 5f47aea78..fff48f03f 100644 --- a/src/map/lapack2flamec/f2c/c/dpftrf.c +++ b/src/map/lapack2flamec/f2c/c/dpftrf.c @@ -204,7 +204,7 @@ int dpftrf_(char *transr, char *uplo, integer *n, doublereal *a, integer *info) extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsyrk_( char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsyrk_( char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int dpotrf_(char *, integer *, doublereal *, integer *, integer *); @@ -246,7 +246,7 @@ int dpftrf_(char *transr, char *uplo, integer *n, doublereal *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("DPFTRF", &i__1); + xerbla_("DPFTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpftri.c b/src/map/lapack2flamec/f2c/c/dpftri.c index db18f631f..40d4cd40e 100644 --- a/src/map/lapack2flamec/f2c/c/dpftri.c +++ b/src/map/lapack2flamec/f2c/c/dpftri.c @@ -197,7 +197,7 @@ int dpftri_(char *transr, char *uplo, integer *n, doublereal *a, integer *info) int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical lower; extern /* Subroutine */ - int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int dlauum_(char *, integer *, doublereal *, integer *, integer *), dtftri_(char *, char *, char *, integer *, doublereal *, integer *); @@ -239,7 +239,7 @@ int dpftri_(char *transr, char *uplo, integer *n, doublereal *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("DPFTRI", &i__1); + xerbla_("DPFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpftrs.c b/src/map/lapack2flamec/f2c/c/dpftrs.c index 319aefcc4..5bdf7997b 100644 --- a/src/map/lapack2flamec/f2c/c/dpftrs.c +++ b/src/map/lapack2flamec/f2c/c/dpftrs.c @@ -202,7 +202,7 @@ int dpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, doublereal *a, int dtfsm_(char *, char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -255,7 +255,7 @@ int dpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DPFTRS", &i__1); + xerbla_("DPFTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpocon.c b/src/map/lapack2flamec/f2c/c/dpocon.c index 252e70891..8b99d0795 100644 --- a/src/map/lapack2flamec/f2c/c/dpocon.c +++ b/src/map/lapack2flamec/f2c/c/dpocon.c @@ -131,7 +131,7 @@ int dpocon_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *an extern integer idamax_(integer *, doublereal *, integer *); doublereal scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dlatrs_(char *, char *, char *, char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *); @@ -188,7 +188,7 @@ int dpocon_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *an if (*info != 0) { i__1 = -(*info); - xerbla_("DPOCON", &i__1); + xerbla_("DPOCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpoequ.c b/src/map/lapack2flamec/f2c/c/dpoequ.c index 38240e4c8..9abcfc025 100644 --- a/src/map/lapack2flamec/f2c/c/dpoequ.c +++ b/src/map/lapack2flamec/f2c/c/dpoequ.c @@ -111,7 +111,7 @@ int dpoequ_(integer *n, doublereal *a, integer *lda, doublereal *s, doublereal * integer i__; doublereal smin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -149,7 +149,7 @@ int dpoequ_(integer *n, doublereal *a, integer *lda, doublereal *s, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DPOEQU", &i__1); + xerbla_("DPOEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpoequb.c b/src/map/lapack2flamec/f2c/c/dpoequb.c index 5703d9e62..45b527864 100644 --- a/src/map/lapack2flamec/f2c/c/dpoequb.c +++ b/src/map/lapack2flamec/f2c/c/dpoequb.c @@ -112,7 +112,7 @@ int dpoequb_(integer *n, doublereal *a, integer *lda, doublereal *s, doublereal doublereal tmp, base, smin; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -153,7 +153,7 @@ int dpoequb_(integer *n, doublereal *a, integer *lda, doublereal *s, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DPOEQUB", &i__1); + xerbla_("DPOEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dporfs.c b/src/map/lapack2flamec/f2c/c/dporfs.c index 185f3382f..62b5ffc99 100644 --- a/src/map/lapack2flamec/f2c/c/dporfs.c +++ b/src/map/lapack2flamec/f2c/c/dporfs.c @@ -197,7 +197,7 @@ int dporfs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dpotrs_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpotrs_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); doublereal lstres; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -273,7 +273,7 @@ int dporfs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DPORFS", &i__1); + xerbla_("DPORFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dporfsx.c b/src/map/lapack2flamec/f2c/c/dporfsx.c index 990a67414..29939e486 100644 --- a/src/map/lapack2flamec/f2c/c/dporfsx.c +++ b/src/map/lapack2flamec/f2c/c/dporfsx.c @@ -414,7 +414,7 @@ int dporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublereal *a, logical rcequ; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dpocon_( char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpocon_( char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern doublereal dlansy_(char *, char *, integer *, doublereal *, integer *, doublereal *); extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -562,7 +562,7 @@ int dporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DPORFSX", &i__1); + xerbla_("DPORFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dposv.c b/src/map/lapack2flamec/f2c/c/dposv.c index b5618e0a2..3b130d250 100644 --- a/src/map/lapack2flamec/f2c/c/dposv.c +++ b/src/map/lapack2flamec/f2c/c/dposv.c @@ -126,7 +126,7 @@ int dposv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, d /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dpotrf_( char *, integer *, doublereal *, integer *, integer *), dpotrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpotrf_( char *, integer *, doublereal *, integer *, integer *), dpotrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int dposv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DPOSV ", &i__1); + xerbla_("DPOSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dposvx.c b/src/map/lapack2flamec/f2c/c/dposvx.c index 99a0723d2..993fb3607 100644 --- a/src/map/lapack2flamec/f2c/c/dposvx.c +++ b/src/map/lapack2flamec/f2c/c/dposvx.c @@ -311,7 +311,7 @@ int dposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, i extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dpocon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); @@ -364,6 +364,8 @@ int dposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, i *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -453,7 +455,7 @@ int dposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DPOSVX", &i__1); + xerbla_("DPOSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dposvxx.c b/src/map/lapack2flamec/f2c/c/dposvxx.c index f38027cee..52c698e77 100644 --- a/src/map/lapack2flamec/f2c/c/dposvxx.c +++ b/src/map/lapack2flamec/f2c/c/dposvxx.c @@ -505,7 +505,7 @@ int dposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer infequ; extern /* Subroutine */ @@ -654,7 +654,7 @@ int dposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DPOSVXX", &i__1); + xerbla_("DPOSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpotrf2.c b/src/map/lapack2flamec/f2c/c/dpotrf2.c index 06f302899..3112d3d31 100644 --- a/src/map/lapack2flamec/f2c/c/dpotrf2.c +++ b/src/map/lapack2flamec/f2c/c/dpotrf2.c @@ -116,7 +116,7 @@ int dpotrf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -160,7 +160,7 @@ int dpotrf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTRF2", &i__1); + xerbla_("DPOTRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpotrs.c b/src/map/lapack2flamec/f2c/c/dpotrs.c index 5e0794004..03f3d3a79 100644 --- a/src/map/lapack2flamec/f2c/c/dpotrs.c +++ b/src/map/lapack2flamec/f2c/c/dpotrs.c @@ -111,7 +111,7 @@ int dpotrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -166,7 +166,7 @@ int dpotrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DPOTRS", &i__1); + xerbla_("DPOTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dppcon.c b/src/map/lapack2flamec/f2c/c/dppcon.c index 918351d80..9fc61dbc5 100644 --- a/src/map/lapack2flamec/f2c/c/dppcon.c +++ b/src/map/lapack2flamec/f2c/c/dppcon.c @@ -130,7 +130,7 @@ int dppcon_(char *uplo, integer *n, doublereal *ap, doublereal *anorm, doublerea extern integer idamax_(integer *, doublereal *, integer *); doublereal scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *), dlatps_( char *, char *, char *, char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlatps_( char *, char *, char *, char *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); doublereal ainvnm; char normin[1]; doublereal smlnum; @@ -179,7 +179,7 @@ int dppcon_(char *uplo, integer *n, doublereal *ap, doublereal *anorm, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DPPCON", &i__1); + xerbla_("DPPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dppequ.c b/src/map/lapack2flamec/f2c/c/dppequ.c index 81bb3d848..a8c5d376b 100644 --- a/src/map/lapack2flamec/f2c/c/dppequ.c +++ b/src/map/lapack2flamec/f2c/c/dppequ.c @@ -119,7 +119,7 @@ int dppequ_(char *uplo, integer *n, doublereal *ap, doublereal *s, doublereal *s extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int dppequ_(char *uplo, integer *n, doublereal *ap, doublereal *s, doublereal *s if (*info != 0) { i__1 = -(*info); - xerbla_("DPPEQU", &i__1); + xerbla_("DPPEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpprfs.c b/src/map/lapack2flamec/f2c/c/dpprfs.c index 9ae2ae326..90dfb63bb 100644 --- a/src/map/lapack2flamec/f2c/c/dpprfs.c +++ b/src/map/lapack2flamec/f2c/c/dpprfs.c @@ -190,7 +190,7 @@ int dpprfs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *a extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int dpptrs_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *); @@ -256,7 +256,7 @@ int dpprfs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DPPRFS", &i__1); + xerbla_("DPPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dppsv.c b/src/map/lapack2flamec/f2c/c/dppsv.c index d4c7bab12..b9c5fe938 100644 --- a/src/map/lapack2flamec/f2c/c/dppsv.c +++ b/src/map/lapack2flamec/f2c/c/dppsv.c @@ -141,7 +141,7 @@ int dppsv_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *b, /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dpptrf_( char *, integer *, doublereal *, integer *), dpptrs_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpptrf_( char *, integer *, doublereal *, integer *), dpptrs_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int dppsv_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *b, if (*info != 0) { i__1 = -(*info); - xerbla_("DPPSV ", &i__1); + xerbla_("DPPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dppsvx.c b/src/map/lapack2flamec/f2c/c/dppsvx.c index 96592fc40..95410e5be 100644 --- a/src/map/lapack2flamec/f2c/c/dppsvx.c +++ b/src/map/lapack2flamec/f2c/c/dppsvx.c @@ -322,7 +322,7 @@ int dppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *ap, extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlansp_(char *, char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -371,6 +371,8 @@ int dppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *ap, *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -452,7 +454,7 @@ int dppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *ap, if (*info != 0) { i__1 = -(*info); - xerbla_("DPPSVX", &i__1); + xerbla_("DPPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpptrf.c b/src/map/lapack2flamec/f2c/c/dpptrf.c index 27d0964af..9f558c1a3 100644 --- a/src/map/lapack2flamec/f2c/c/dpptrf.c +++ b/src/map/lapack2flamec/f2c/c/dpptrf.c @@ -128,7 +128,7 @@ int dpptrf_(char *uplo, integer *n, doublereal *ap, integer * info) extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -166,7 +166,7 @@ int dpptrf_(char *uplo, integer *n, doublereal *ap, integer * info) if (*info != 0) { i__1 = -(*info); - xerbla_("DPPTRF", &i__1); + xerbla_("DPPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpptri.c b/src/map/lapack2flamec/f2c/c/dpptri.c index 20b784201..533155631 100644 --- a/src/map/lapack2flamec/f2c/c/dpptri.c +++ b/src/map/lapack2flamec/f2c/c/dpptri.c @@ -102,7 +102,7 @@ int dpptri_(char *uplo, integer *n, doublereal *ap, integer * info) int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), dtptri_( char *, char *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtptri_( char *, char *, integer *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -138,7 +138,7 @@ int dpptri_(char *uplo, integer *n, doublereal *ap, integer * info) if (*info != 0) { i__1 = -(*info); - xerbla_("DPPTRI", &i__1); + xerbla_("DPPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpptrs.c b/src/map/lapack2flamec/f2c/c/dpptrs.c index c3de5f668..decf987c5 100644 --- a/src/map/lapack2flamec/f2c/c/dpptrs.c +++ b/src/map/lapack2flamec/f2c/c/dpptrs.c @@ -109,7 +109,7 @@ int dpptrs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *b extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,7 +156,7 @@ int dpptrs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *b if (*info != 0) { i__1 = -(*info); - xerbla_("DPPTRS", &i__1); + xerbla_("DPPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpstf2.c b/src/map/lapack2flamec/f2c/c/dpstf2.c index cc4a3b5b5..6bf1fea1d 100644 --- a/src/map/lapack2flamec/f2c/c/dpstf2.c +++ b/src/map/lapack2flamec/f2c/c/dpstf2.c @@ -158,7 +158,7 @@ int dpstf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *piv, extern doublereal dlamch_(char *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer dmaxloc_(doublereal *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -205,7 +205,7 @@ int dpstf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *piv, if (*info != 0) { i__1 = -(*info); - xerbla_("DPSTF2", &i__1); + xerbla_("DPSTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpstrf.c b/src/map/lapack2flamec/f2c/c/dpstrf.c index 0bc5cfc9c..5235decd3 100644 --- a/src/map/lapack2flamec/f2c/c/dpstrf.c +++ b/src/map/lapack2flamec/f2c/c/dpstrf.c @@ -161,7 +161,7 @@ int dpstrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *piv, extern doublereal dlamch_(char *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *), dmaxloc_(doublereal *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -208,7 +208,7 @@ int dpstrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *piv, if (*info != 0) { i__1 = -(*info); - xerbla_("DPSTRF", &i__1); + xerbla_("DPSTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dptcon.c b/src/map/lapack2flamec/f2c/c/dptcon.c index b8898f645..890156980 100644 --- a/src/map/lapack2flamec/f2c/c/dptcon.c +++ b/src/map/lapack2flamec/f2c/c/dptcon.c @@ -117,7 +117,7 @@ int dptcon_(integer *n, doublereal *d__, doublereal *e, doublereal *anorm, doubl integer i__, ix; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -157,7 +157,7 @@ int dptcon_(integer *n, doublereal *d__, doublereal *e, doublereal *anorm, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DPTCON", &i__1); + xerbla_("DPTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpteqr.c b/src/map/lapack2flamec/f2c/c/dpteqr.c index f3cad8007..2f4271224 100644 --- a/src/map/lapack2flamec/f2c/c/dpteqr.c +++ b/src/map/lapack2flamec/f2c/c/dpteqr.c @@ -155,7 +155,7 @@ int dpteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal integer nru; extern logical lsame_(char *, char *); extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer icompz; extern /* Subroutine */ int dpttrf_(integer *, doublereal *, doublereal *, integer *); @@ -222,7 +222,7 @@ int dpteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DPTEQR", &i__1); + xerbla_("DPTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dptrfs.c b/src/map/lapack2flamec/f2c/c/dptrfs.c index 1f2af9cef..57939521f 100644 --- a/src/map/lapack2flamec/f2c/c/dptrfs.c +++ b/src/map/lapack2flamec/f2c/c/dptrfs.c @@ -169,7 +169,7 @@ int dptrfs_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublerea extern integer idamax_(integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int dpttrs_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); @@ -229,7 +229,7 @@ int dptrfs_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DPTRFS", &i__1); + xerbla_("DPTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dptsv.c b/src/map/lapack2flamec/f2c/c/dptsv.c index 06cdd5cd4..0d157eb95 100644 --- a/src/map/lapack2flamec/f2c/c/dptsv.c +++ b/src/map/lapack2flamec/f2c/c/dptsv.c @@ -108,7 +108,7 @@ int dptsv_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublereal integer b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), dpttrf_( integer *, doublereal *, doublereal *, integer *), dpttrs_( integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpttrf_( integer *, doublereal *, doublereal *, integer *), dpttrs_( integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -147,7 +147,7 @@ int dptsv_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DPTSV ", &i__1); + xerbla_("DPTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dptsvx.c b/src/map/lapack2flamec/f2c/c/dptsvx.c index 1c92d2765..ba9c1c21a 100644 --- a/src/map/lapack2flamec/f2c/c/dptsvx.c +++ b/src/map/lapack2flamec/f2c/c/dptsvx.c @@ -228,7 +228,7 @@ int dptsvx_(char *fact, integer *n, integer *nrhs, doublereal *d__, doublereal * extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int dptcon_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *), dptrfs_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dpttrf_( integer *, doublereal *, doublereal *, integer *), dpttrs_( integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); @@ -293,7 +293,7 @@ int dptsvx_(char *fact, integer *n, integer *nrhs, doublereal *d__, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DPTSVX", &i__1); + xerbla_("DPTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpttrf.c b/src/map/lapack2flamec/f2c/c/dpttrf.c index 70a7546e1..a7c0d43f6 100644 --- a/src/map/lapack2flamec/f2c/c/dpttrf.c +++ b/src/map/lapack2flamec/f2c/c/dpttrf.c @@ -88,7 +88,7 @@ int dpttrf_(integer *n, doublereal *d__, doublereal *e, integer *info) integer i__, i4; doublereal ei; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -117,7 +117,7 @@ int dpttrf_(integer *n, doublereal *d__, doublereal *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("DPTTRF", &i__1); + xerbla_("DPTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dpttrs.c b/src/map/lapack2flamec/f2c/c/dpttrs.c index 35b5283b4..c4783c7bc 100644 --- a/src/map/lapack2flamec/f2c/c/dpttrs.c +++ b/src/map/lapack2flamec/f2c/c/dpttrs.c @@ -107,7 +107,7 @@ int dpttrs_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublerea /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int dptts2_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dptts2_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -151,7 +151,7 @@ int dpttrs_(integer *n, integer *nrhs, doublereal *d__, doublereal *e, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("DPTTRS", &i__1); + xerbla_("DPTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsb2st_kernels.c b/src/map/lapack2flamec/f2c/c/dsb2st_kernels.c index d1f7dad79..1679a2b19 100644 --- a/src/map/lapack2flamec/f2c/c/dsb2st_kernels.c +++ b/src/map/lapack2flamec/f2c/c/dsb2st_kernels.c @@ -173,7 +173,6 @@ int dsb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in logical upper; extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); - integer ajeter; extern /* Subroutine */ int dlarfx_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *), dlarfy_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); integer ofdpos, taupos; @@ -205,7 +204,6 @@ int dsb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in --tau; --work; /* Function Body */ - ajeter = *ib + *ldvt; upper = lsame_(uplo, "U"); if (upper) { diff --git a/src/map/lapack2flamec/f2c/c/dsbev.c b/src/map/lapack2flamec/f2c/c/dsbev.c index 7085dd156..05af59735 100644 --- a/src/map/lapack2flamec/f2c/c/dsbev.c +++ b/src/map/lapack2flamec/f2c/c/dsbev.c @@ -166,7 +166,7 @@ int dsbev_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *ab, inte extern doublereal dlansb_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsterf_( integer *, doublereal *, doublereal *, integer *); @@ -235,7 +235,7 @@ int dsbev_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *ab, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEV ", &i__1); + xerbla_("DSBEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbev_2stage.c b/src/map/lapack2flamec/f2c/c/dsbev_2stage.c index 809e5f096..fd6506e0d 100644 --- a/src/map/lapack2flamec/f2c/c/dsbev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsbev_2stage.c @@ -231,7 +231,7 @@ int dsbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *a extern doublereal dlansb_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *); @@ -324,7 +324,7 @@ int dsbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEV_2STAGE ", &i__1); + xerbla_("DSBEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbevd.c b/src/map/lapack2flamec/f2c/c/dsbevd.c index 164270bba..66256952d 100644 --- a/src/map/lapack2flamec/f2c/c/dsbevd.c +++ b/src/map/lapack2flamec/f2c/c/dsbevd.c @@ -217,7 +217,7 @@ int dsbevd_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *ab, int int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsterf_( integer *, doublereal *, doublereal *, integer *); @@ -320,7 +320,7 @@ int dsbevd_(char *jobz, char *uplo, integer *n, integer *kd, doublereal *ab, int if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEVD", &i__1); + xerbla_("DSBEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbevd_2stage.c b/src/map/lapack2flamec/f2c/c/dsbevd_2stage.c index e498ac262..c3ae34676 100644 --- a/src/map/lapack2flamec/f2c/c/dsbevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsbevd_2stage.c @@ -264,7 +264,7 @@ int dsbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublereal * int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *); @@ -374,7 +374,7 @@ int dsbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEVD_2STAGE", &i__1); + xerbla_("DSBEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbevx.c b/src/map/lapack2flamec/f2c/c/dsbevx.c index 2ceabe630..8c2d54ada 100644 --- a/src/map/lapack2flamec/f2c/c/dsbevx.c +++ b/src/map/lapack2flamec/f2c/c/dsbevx.c @@ -293,7 +293,7 @@ int dsbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, double int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; extern /* Subroutine */ int dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *); @@ -409,7 +409,7 @@ int dsbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, double if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEVX", &i__1); + xerbla_("DSBEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbevx_2stage.c b/src/map/lapack2flamec/f2c/c/dsbevx_2stage.c index 79858511f..b06622f62 100644 --- a/src/map/lapack2flamec/f2c/c/dsbevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsbevx_2stage.c @@ -368,7 +368,7 @@ int dsbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indisp; extern /* Subroutine */ @@ -505,7 +505,7 @@ int dsbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, if (*info != 0) { i__1 = -(*info); - xerbla_("DSBEVX_2STAGE ", &i__1); + xerbla_("DSBEVX_2STAGE ", &i__1, (ftnlen)14); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbgst.c b/src/map/lapack2flamec/f2c/c/dsbgst.c index 1c2ee18d2..bc81ac2a6 100644 --- a/src/map/lapack2flamec/f2c/c/dsbgst.c +++ b/src/map/lapack2flamec/f2c/c/dsbgst.c @@ -175,7 +175,7 @@ int dsbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, double extern logical lsame_(char *, char *); logical upper, wantx; extern /* Subroutine */ - int dlar2v_(integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_( char *, integer *), dlargv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int dlar2v_(integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlargv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical update; extern /* Subroutine */ int dlartv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); @@ -252,7 +252,7 @@ int dsbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, double if (*info != 0) { i__1 = -(*info); - xerbla_("DSBGST", &i__1); + xerbla_("DSBGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbgv.c b/src/map/lapack2flamec/f2c/c/dsbgv.c index caabc6d99..8aae882fb 100644 --- a/src/map/lapack2flamec/f2c/c/dsbgv.c +++ b/src/map/lapack2flamec/f2c/c/dsbgv.c @@ -180,7 +180,7 @@ int dsbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, doubler integer iinfo; logical upper, wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dpbstf_( char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsbgst_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dsterf_(integer *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbstf_( char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsbgst_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dsterf_(integer *, doublereal *, doublereal *, integer *); integer indwrk; extern /* Subroutine */ int dsteqr_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *); @@ -252,7 +252,7 @@ int dsbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DSBGV ", &i__1); + xerbla_("DSBGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbgvd.c b/src/map/lapack2flamec/f2c/c/dsbgvd.c index 7caa8e3ff..4982b5851 100644 --- a/src/map/lapack2flamec/f2c/c/dsbgvd.c +++ b/src/map/lapack2flamec/f2c/c/dsbgvd.c @@ -237,7 +237,7 @@ int dsbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, double logical upper, wantz; integer indwk2, llwrk2; extern /* Subroutine */ - int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dpbstf_(char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsbgst_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dsterf_(integer *, doublereal *, doublereal *, integer *); + int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbstf_(char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *), dsbgst_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dsterf_(integer *, doublereal *, doublereal *, integer *); integer indwrk, liwmin; logical lquery; /* -- LAPACK driver routine (version 3.7.0) -- */ @@ -342,7 +342,7 @@ int dsbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, double if (*info != 0) { i__1 = -(*info); - xerbla_("DSBGVD", &i__1); + xerbla_("DSBGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbgvx.c b/src/map/lapack2flamec/f2c/c/dsbgvx.c index 60caf5e04..59c62c022 100644 --- a/src/map/lapack2flamec/f2c/c/dsbgvx.c +++ b/src/map/lapack2flamec/f2c/c/dsbgvx.c @@ -302,7 +302,7 @@ int dsbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege integer indibl; logical valeig; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dpbstf_(char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_( char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpbstf_(char *, integer *, integer *, doublereal *, integer *, integer *), dsbtrd_( char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *); integer indisp; extern /* Subroutine */ int dsbgst_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dstein_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *); @@ -425,7 +425,7 @@ int dsbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DSBGVX", &i__1); + xerbla_("DSBGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsbtrd.c b/src/map/lapack2flamec/f2c/c/dsbtrd.c index 2c63bca9e..34c769129 100644 --- a/src/map/lapack2flamec/f2c/c/dsbtrd.c +++ b/src/map/lapack2flamec/f2c/c/dsbtrd.c @@ -180,7 +180,7 @@ int dsbtrd_(char *vect, char *uplo, integer *n, integer *kd, doublereal *ab, int int dlar2v_(integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer iqaend; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *), dlargv_( integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlartv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlargv_( integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlartv_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -248,7 +248,7 @@ int dsbtrd_(char *vect, char *uplo, integer *n, integer *kd, doublereal *ab, int if (*info != 0) { i__1 = -(*info); - xerbla_("DSBTRD", &i__1); + xerbla_("DSBTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsfrk.c b/src/map/lapack2flamec/f2c/c/dsfrk.c index af1d91e46..ebaff79a7 100644 --- a/src/map/lapack2flamec/f2c/c/dsfrk.c +++ b/src/map/lapack2flamec/f2c/c/dsfrk.c @@ -167,7 +167,7 @@ int dsfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, double integer nrowa; logical lower; extern /* Subroutine */ - int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -236,7 +236,7 @@ int dsfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, double if (info != 0) { i__1 = -info; - xerbla_("DSFRK ", &i__1); + xerbla_("DSFRK ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsgesv.c b/src/map/lapack2flamec/f2c/c/dsgesv.c index 3ee29ab9b..4491db3f1 100644 --- a/src/map/lapack2flamec/f2c/c/dsgesv.c +++ b/src/map/lapack2flamec/f2c/c/dsgesv.c @@ -209,7 +209,7 @@ int dsgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipi extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), sgetrf_(integer *, integer *, real *, integer *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgetrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), sgetrf_(integer *, integer *, real *, integer *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -270,7 +270,7 @@ int dsgesv_(integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("DSGESV", &i__1); + xerbla_("DSGESV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspcon.c b/src/map/lapack2flamec/f2c/c/dspcon.c index d516218c4..b8cb484d7 100644 --- a/src/map/lapack2flamec/f2c/c/dspcon.c +++ b/src/map/lapack2flamec/f2c/c/dspcon.c @@ -125,7 +125,7 @@ int dspcon_(char *uplo, integer *n, doublereal *ap, integer * ipiv, doublereal * integer isave[3]; logical upper; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -173,7 +173,7 @@ int dspcon_(char *uplo, integer *n, doublereal *ap, integer * ipiv, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSPCON", &i__1); + xerbla_("DSPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspev.c b/src/map/lapack2flamec/f2c/c/dspev.c index 68c6217bb..524b50472 100644 --- a/src/map/lapack2flamec/f2c/c/dspev.c +++ b/src/map/lapack2flamec/f2c/c/dspev.c @@ -147,7 +147,7 @@ int dspev_(char *jobz, char *uplo, integer *n, doublereal * ap, doublereal *w, d integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlansp_(char *, char *, integer *, doublereal *, doublereal *); integer indtau; @@ -207,7 +207,7 @@ int dspev_(char *jobz, char *uplo, integer *n, doublereal * ap, doublereal *w, d if (*info != 0) { i__1 = -(*info); - xerbla_("DSPEV ", &i__1); + xerbla_("DSPEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspevd.c b/src/map/lapack2flamec/f2c/c/dspevd.c index f5f5d7021..d72c2c5c1 100644 --- a/src/map/lapack2flamec/f2c/c/dspevd.c +++ b/src/map/lapack2flamec/f2c/c/dspevd.c @@ -197,7 +197,7 @@ int dspevd_(char *jobz, char *uplo, integer *n, doublereal * ap, doublereal *w, int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlansp_(char *, char *, integer *, doublereal *, doublereal *); integer indtau; @@ -294,7 +294,7 @@ int dspevd_(char *jobz, char *uplo, integer *n, doublereal * ap, doublereal *w, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPEVD", &i__1); + xerbla_("DSPEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspevx.c b/src/map/lapack2flamec/f2c/c/dspevx.c index 1273c6d03..6618e3be7 100644 --- a/src/map/lapack2flamec/f2c/c/dspevx.c +++ b/src/map/lapack2flamec/f2c/c/dspevx.c @@ -253,7 +253,7 @@ int dspevx_(char *jobz, char *range, char *uplo, integer *n, doublereal *ap, dou logical valeig; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; extern doublereal dlansp_(char *, char *, integer *, doublereal *, doublereal *); integer indtau, indisp; @@ -350,7 +350,7 @@ int dspevx_(char *jobz, char *range, char *uplo, integer *n, doublereal *ap, dou if (*info != 0) { i__1 = -(*info); - xerbla_("DSPEVX", &i__1); + xerbla_("DSPEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspgst.c b/src/map/lapack2flamec/f2c/c/dspgst.c index ea090ca92..f4b367cc0 100644 --- a/src/map/lapack2flamec/f2c/c/dspgst.c +++ b/src/map/lapack2flamec/f2c/c/dspgst.c @@ -128,7 +128,7 @@ int dspgst_(integer *itype, char *uplo, integer *n, doublereal *ap, doublereal * int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dspmv_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -169,7 +169,7 @@ int dspgst_(integer *itype, char *uplo, integer *n, doublereal *ap, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSPGST", &i__1); + xerbla_("DSPGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspgv.c b/src/map/lapack2flamec/f2c/c/dspgv.c index 9400fa8b2..ccfe1737a 100644 --- a/src/map/lapack2flamec/f2c/c/dspgv.c +++ b/src/map/lapack2flamec/f2c/c/dspgv.c @@ -171,7 +171,7 @@ int dspgv_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *ap, int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *); logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dpptrf_( char *, integer *, doublereal *, integer *), dspgst_( integer *, char *, integer *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpptrf_( char *, integer *, doublereal *, integer *), dspgst_( integer *, char *, integer *, doublereal *, doublereal *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -224,7 +224,7 @@ int dspgv_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *ap, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPGV ", &i__1); + xerbla_("DSPGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspgvd.c b/src/map/lapack2flamec/f2c/c/dspgvd.c index c2cbaa80a..db9fbeaa6 100644 --- a/src/map/lapack2flamec/f2c/c/dspgvd.c +++ b/src/map/lapack2flamec/f2c/c/dspgvd.c @@ -222,7 +222,7 @@ int dspgvd_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *ap, int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *); logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dspevd_( char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dspevd_( char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *); integer liwmin; extern /* Subroutine */ int dpptrf_(char *, integer *, doublereal *, integer *), dspgst_(integer *, char *, integer *, doublereal *, doublereal *, integer *); @@ -316,7 +316,7 @@ int dspgvd_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *ap, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPGVD", &i__1); + xerbla_("DSPGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspgvx.c b/src/map/lapack2flamec/f2c/c/dspgvx.c index 1dec72b1e..72bfbfc2e 100644 --- a/src/map/lapack2flamec/f2c/c/dspgvx.c +++ b/src/map/lapack2flamec/f2c/c/dspgvx.c @@ -271,7 +271,7 @@ int dspgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *); logical wantz, alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *), dpptrf_( char *, integer *, doublereal *, integer *), dspgst_( integer *, char *, integer *, doublereal *, doublereal *, integer *), dspevx_(char *, char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpptrf_( char *, integer *, doublereal *, integer *), dspgst_( integer *, char *, integer *, doublereal *, doublereal *, integer *), dspevx_(char *, char *, char *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -359,7 +359,7 @@ int dspgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("DSPGVX", &i__1); + xerbla_("DSPGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsposv.c b/src/map/lapack2flamec/f2c/c/dsposv.c index f5fce02fa..95985e8ae 100644 --- a/src/map/lapack2flamec/f2c/c/dsposv.c +++ b/src/map/lapack2flamec/f2c/c/dsposv.c @@ -211,7 +211,7 @@ int dsposv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlansy_(char *, char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int dpotrf_(char *, integer *, doublereal *, integer *, integer *), dpotrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), spotrf_(char *, integer *, real *, integer *, integer *), spotrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -278,7 +278,7 @@ int dsposv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPOSV", &i__1); + xerbla_("DSPOSV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsprfs.c b/src/map/lapack2flamec/f2c/c/dsprfs.c index 87b14e2b3..cf6941217 100644 --- a/src/map/lapack2flamec/f2c/c/dsprfs.c +++ b/src/map/lapack2flamec/f2c/c/dsprfs.c @@ -198,7 +198,7 @@ int dsprfs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *a extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -265,7 +265,7 @@ int dsprfs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DSPRFS", &i__1); + xerbla_("DSPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspsv.c b/src/map/lapack2flamec/f2c/c/dspsv.c index fd3297fa2..1459e29bc 100644 --- a/src/map/lapack2flamec/f2c/c/dspsv.c +++ b/src/map/lapack2flamec/f2c/c/dspsv.c @@ -159,7 +159,7 @@ int dspsv_(char *uplo, integer *n, integer *nrhs, doublereal *ap, integer *ipiv, /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dsptrf_( char *, integer *, doublereal *, integer *, integer *), dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dsptrf_( char *, integer *, doublereal *, integer *, integer *), dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -204,7 +204,7 @@ int dspsv_(char *uplo, integer *n, integer *nrhs, doublereal *ap, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPSV ", &i__1); + xerbla_("DSPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dspsvx.c b/src/map/lapack2flamec/f2c/c/dspsvx.c index e2c9112ac..dd7b2b129 100644 --- a/src/map/lapack2flamec/f2c/c/dspsvx.c +++ b/src/map/lapack2flamec/f2c/c/dspsvx.c @@ -279,7 +279,7 @@ int dspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *ap, extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlansp_(char *, char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int dspcon_(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dsprfs_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *), dsptrf_(char *, integer *, doublereal *, integer *, integer *), dsptrs_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -348,7 +348,7 @@ int dspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *ap, if (*info != 0) { i__1 = -(*info); - xerbla_("DSPSVX", &i__1); + xerbla_("DSPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsptrd.c b/src/map/lapack2flamec/f2c/c/dsptrd.c index 5d81c8dfb..124923207 100644 --- a/src/map/lapack2flamec/f2c/c/dsptrd.c +++ b/src/map/lapack2flamec/f2c/c/dsptrd.c @@ -163,7 +163,7 @@ int dsptrd_(char *uplo, integer *n, doublereal *ap, doublereal *d__, doublereal int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dspmv_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -202,7 +202,7 @@ int dsptrd_(char *uplo, integer *n, doublereal *ap, doublereal *d__, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSPTRD", &i__1); + xerbla_("DSPTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsptrf.c b/src/map/lapack2flamec/f2c/c/dsptrf.c index 1e9be9cfd..32bf4f29f 100644 --- a/src/map/lapack2flamec/f2c/c/dsptrf.c +++ b/src/map/lapack2flamec/f2c/c/dsptrf.c @@ -178,7 +178,7 @@ int dsptrf_(char *uplo, integer *n, doublereal *ap, integer * ipiv, integer *inf doublereal absakk; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax, rowmax; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -207,6 +207,7 @@ int dsptrf_(char *uplo, integer *n, doublereal *ap, integer * ipiv, integer *inf /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -218,7 +219,7 @@ int dsptrf_(char *uplo, integer *n, doublereal *ap, integer * ipiv, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("DSPTRF", &i__1); + xerbla_("DSPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsptri.c b/src/map/lapack2flamec/f2c/c/dsptri.c index d00914709..d13e04648 100644 --- a/src/map/lapack2flamec/f2c/c/dsptri.c +++ b/src/map/lapack2flamec/f2c/c/dsptri.c @@ -125,7 +125,7 @@ int dsptri_(char *uplo, integer *n, doublereal *ap, integer * ipiv, doublereal * int dspmv_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -166,7 +166,7 @@ int dsptri_(char *uplo, integer *n, doublereal *ap, integer * ipiv, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSPTRI", &i__1); + xerbla_("DSPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsptrs.c b/src/map/lapack2flamec/f2c/c/dsptrs.c index a263b4f5f..c1fda5347 100644 --- a/src/map/lapack2flamec/f2c/c/dsptrs.c +++ b/src/map/lapack2flamec/f2c/c/dsptrs.c @@ -129,7 +129,7 @@ int dsptrs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, integer *ipiv int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -178,7 +178,7 @@ int dsptrs_(char *uplo, integer *n, integer *nrhs, doublereal *ap, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DSPTRS", &i__1); + xerbla_("DSPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstebz.c b/src/map/lapack2flamec/f2c/c/dstebz.c index 7749754e6..f936c7ccb 100644 --- a/src/map/lapack2flamec/f2c/c/dstebz.c +++ b/src/map/lapack2flamec/f2c/c/dstebz.c @@ -290,7 +290,7 @@ int dstebz_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu doublereal safemn; integer idumma[1]; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer idiscu, iorder; logical ncnvrg; @@ -328,6 +328,8 @@ int dstebz_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu --d__; /* Function Body */ *info = 0; + wlu = 0; + wul = 0; /* Decode RANGE */ if (lsame_(range, "A")) { @@ -389,7 +391,7 @@ int dstebz_(char *range, char *order, integer *n, doublereal *vl, doublereal *vu if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEBZ", &i__1); + xerbla_("DSTEBZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstedc.c b/src/map/lapack2flamec/f2c/c/dstedc.c index 6f2653399..452416094 100644 --- a/src/map/lapack2flamec/f2c/c/dstedc.c +++ b/src/map/lapack2flamec/f2c/c/dstedc.c @@ -212,7 +212,7 @@ int dstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer finish; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -254,6 +254,8 @@ int dstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal --iwork; /* Function Body */ *info = 0; + lwmin = 0; + liwmin = 0; lquery = *lwork == -1 || *liwork == -1; if (lsame_(compz, "N")) { @@ -337,7 +339,7 @@ int dstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEDC", &i__1); + xerbla_("DSTEDC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstein.c b/src/map/lapack2flamec/f2c/c/dstein.c index 3ce6d2d3c..362c6205b 100644 --- a/src/map/lapack2flamec/f2c/c/dstein.c +++ b/src/map/lapack2flamec/f2c/c/dstein.c @@ -193,7 +193,7 @@ int dstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * int dlagtf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), dlagts_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlagts_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nrmchk; extern /* Subroutine */ int dlarnv_(integer *, integer *, integer *, doublereal *); @@ -237,6 +237,11 @@ int dstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * /* Function Body */ *info = 0; i__1 = *m; + dtpcrt = 0.; + onenrm = 0.; + ortol = 0.; + xjm = 0.; + gpind = 0; for (i__ = 1; i__ <= i__1; ++i__) @@ -281,7 +286,7 @@ int dstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEIN", &i__1); + xerbla_("DSTEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstemr.c b/src/map/lapack2flamec/f2c/c/dstemr.c index d2b3cd61c..3263ab518 100644 --- a/src/map/lapack2flamec/f2c/c/dstemr.c +++ b/src/map/lapack2flamec/f2c/c/dstemr.c @@ -361,7 +361,7 @@ int dstemr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e integer wbegin; doublereal safmin; extern /* Subroutine */ - int dlarrj_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarrj_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer inderr, iindwk, indgrs, offset; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); @@ -525,7 +525,7 @@ int dstemr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEMR", &i__1); + xerbla_("DSTEMR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsteqr.c b/src/map/lapack2flamec/f2c/c/dsteqr.c index b29d95fee..43bed2c2d 100644 --- a/src/map/lapack2flamec/f2c/c/dsteqr.c +++ b/src/map/lapack2flamec/f2c/c/dsteqr.c @@ -162,10 +162,12 @@ int dsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *, integer *); + extern /* Subroutine */ + int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer *lda, doublereal *w, doublereal *work, integer *lwork, integer *iwork, integer *liwork, integer *info); integer lendsv; doublereal ssfmin; integer nmaxit, icompz; @@ -233,7 +235,7 @@ int dsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEQR", &i__1); + xerbla_("DSTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -282,12 +284,12 @@ int dsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublereal z__[i * LDZ + i + 1] = e[i]; } - dsteqr_helper_("V", "L", &N, &z__[z_offset], &LDZ, &d__[1], &wkopt, &lwork, &iwkopt, &liwork, &info); + dsteqr_helper_("V", "L", &N, &z__[z_offset], &LDZ, &d__[1], &wkopt, &lwork, &iwkopt, &liwork, info); lwork = (integer)wkopt; worker = (doublereal*)malloc( lwork*sizeof(doublereal) ); liwork = iwkopt; iwork = (integer*)malloc( liwork*sizeof(integer) ); - dsteqr_helper_("V", "L", &N, &z__[z_offset], &LDZ, &d__[1], worker,&lwork, iwork, &liwork, &info); + dsteqr_helper_("V", "L", &N, &z__[z_offset], &LDZ, &d__[1], worker,&lwork, iwork, &liwork, info); free(worker); free(iwork); AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/f2c/c/dsteqr_helper.c b/src/map/lapack2flamec/f2c/c/dsteqr_helper.c index 7ffdb9cb6..765230328 100644 --- a/src/map/lapack2flamec/f2c/c/dsteqr_helper.c +++ b/src/map/lapack2flamec/f2c/c/dsteqr_helper.c @@ -26,7 +26,7 @@ int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer * doublereal sigma; extern logical lsame_(char *, char *); integer iinfo, lwmin, liopt; - logical lower, wantz; + logical wantz; integer indwk2, llwrk2; extern doublereal dlamch_(char *); integer iscale; @@ -35,7 +35,7 @@ int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer * doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -44,6 +44,8 @@ int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer * integer indwrk, liwmin; extern /* Subroutine */ int dormtr_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); + extern /* Subroutine */ + int dsytrd_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal * work, integer *lwork, integer *info); integer llwork; doublereal smlnum; logical lquery; @@ -77,7 +79,6 @@ int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer * --iwork; /* Function Body */ wantz = lsame_(jobz, "V"); - lower = lsame_(uplo, "L"); lquery = *lwork == -1 || *liwork == -1; *info = 0; @@ -124,7 +125,7 @@ int dsteqr_helper_(char *jobz, char *uplo, integer *n, doublereal * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVD", &i__1); + xerbla_("DSYEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsteqr_internal.c b/src/map/lapack2flamec/f2c/c/dsteqr_internal.c index 22501f330..2a9d5ffa2 100644 --- a/src/map/lapack2flamec/f2c/c/dsteqr_internal.c +++ b/src/map/lapack2flamec/f2c/c/dsteqr_internal.c @@ -163,7 +163,7 @@ int dsteqr_internal_(char *compz, integer *n, doublereal *d__, doublereal *e, do int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *, integer *); @@ -232,7 +232,7 @@ int dsteqr_internal_(char *compz, integer *n, doublereal *d__, doublereal *e, do if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEQR", &i__1); + xerbla_("DSTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsterf.c b/src/map/lapack2flamec/f2c/c/dsterf.c index 776d2e533..744b8e70c 100644 --- a/src/map/lapack2flamec/f2c/c/dsterf.c +++ b/src/map/lapack2flamec/f2c/c/dsterf.c @@ -95,7 +95,6 @@ int dsterf_(integer *n, doublereal *d__, doublereal *e, integer *info) integer lsv; doublereal eps2, oldc; integer lend; - doublereal rmax; integer jtot; extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); @@ -106,7 +105,7 @@ int dsterf_(integer *n, doublereal *d__, doublereal *e, integer *info) int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal oldgam, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -146,7 +145,7 @@ int dsterf_(integer *n, doublereal *d__, doublereal *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("DSTERF", &i__1); + xerbla_("DSTERF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -164,7 +163,6 @@ int dsterf_(integer *n, doublereal *d__, doublereal *e, integer *info) safmax = 1. / safmin; ssfmax = sqrt(safmax) / 3.; ssfmin = sqrt(safmin) / eps2; - rmax = dlamch_("O"); /* Compute the eigenvalues of the tridiagonal matrix. */ nmaxit = *n * 30; sigma = 0.; diff --git a/src/map/lapack2flamec/f2c/c/dstev.c b/src/map/lapack2flamec/f2c/c/dstev.c index 8637064ce..2c13e91da 100644 --- a/src/map/lapack2flamec/f2c/c/dstev.c +++ b/src/map/lapack2flamec/f2c/c/dstev.c @@ -128,7 +128,7 @@ int dstev_(char *jobz, integer *n, doublereal *d__, doublereal *e, doublereal *z integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -180,7 +180,7 @@ int dstev_(char *jobz, integer *n, doublereal *d__, doublereal *e, doublereal *z if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEV ", &i__1); + xerbla_("DSTEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstevd.c b/src/map/lapack2flamec/f2c/c/dstevd.c index 3f749c196..c0bc7f6c0 100644 --- a/src/map/lapack2flamec/f2c/c/dstevd.c +++ b/src/map/lapack2flamec/f2c/c/dstevd.c @@ -177,7 +177,7 @@ int dstevd_(char *jobz, integer *n, doublereal *d__, doublereal *e, doublereal * int dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -255,7 +255,7 @@ int dstevd_(char *jobz, integer *n, doublereal *d__, doublereal *e, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEVD", &i__1); + xerbla_("DSTEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstevr.c b/src/map/lapack2flamec/f2c/c/dstevr.c index 6f7b4e65e..cfc25e353 100644 --- a/src/map/lapack2flamec/f2c/c/dstevr.c +++ b/src/map/lapack2flamec/f2c/c/dstevr.c @@ -333,7 +333,7 @@ int dstevr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); integer indisp; @@ -450,7 +450,7 @@ int dstevr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEVR", &i__1); + xerbla_("DSTEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dstevx.c b/src/map/lapack2flamec/f2c/c/dstevx.c index 7f9ee5fcd..a2f6dfcfc 100644 --- a/src/map/lapack2flamec/f2c/c/dstevx.c +++ b/src/map/lapack2flamec/f2c/c/dstevx.c @@ -241,7 +241,7 @@ int dstevx_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e logical valeig; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); integer indisp; @@ -335,7 +335,7 @@ int dstevx_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DSTEVX", &i__1); + xerbla_("DSTEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsycon.c b/src/map/lapack2flamec/f2c/c/dsycon.c index 415c990d6..ad418bea1 100644 --- a/src/map/lapack2flamec/f2c/c/dsycon.c +++ b/src/map/lapack2flamec/f2c/c/dsycon.c @@ -130,7 +130,7 @@ int dsycon_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, integer isave[3]; logical upper; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -186,7 +186,7 @@ int dsycon_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCON", &i__1); + xerbla_("DSYCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsycon_3.c b/src/map/lapack2flamec/f2c/c/dsycon_3.c index 7cfa8f92a..e65378298 100644 --- a/src/map/lapack2flamec/f2c/c/dsycon_3.c +++ b/src/map/lapack2flamec/f2c/c/dsycon_3.c @@ -174,7 +174,7 @@ int dsycon_3_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *e integer isave[3]; logical upper; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -229,7 +229,7 @@ int dsycon_3_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCON_3", &i__1); + xerbla_("DSYCON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsycon_rook.c b/src/map/lapack2flamec/f2c/c/dsycon_rook.c index 72c5dde9a..623c5a58c 100644 --- a/src/map/lapack2flamec/f2c/c/dsycon_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsycon_rook.c @@ -146,7 +146,7 @@ int dsycon_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i integer isave[3]; logical upper; extern /* Subroutine */ - int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -200,7 +200,7 @@ int dsycon_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCON_ROOK", &i__1); + xerbla_("DSYCON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyconv.c b/src/map/lapack2flamec/f2c/c/dsyconv.c index 79a772193..c72389a33 100644 --- a/src/map/lapack2flamec/f2c/c/dsyconv.c +++ b/src/map/lapack2flamec/f2c/c/dsyconv.c @@ -113,7 +113,7 @@ int dsyconv_(char *uplo, char *way, integer *n, doublereal * a, integer *lda, in extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -160,7 +160,7 @@ int dsyconv_(char *uplo, char *way, integer *n, doublereal * a, integer *lda, in if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCONV", &i__1); + xerbla_("DSYCONV", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyconvf.c b/src/map/lapack2flamec/f2c/c/dsyconvf.c index 8d4ead849..198bbce0a 100644 --- a/src/map/lapack2flamec/f2c/c/dsyconvf.c +++ b/src/map/lapack2flamec/f2c/c/dsyconvf.c @@ -209,7 +209,7 @@ int dsyconvf_(char *uplo, char *way, integer *n, doublereal * a, integer *lda, d int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -256,7 +256,7 @@ int dsyconvf_(char *uplo, char *way, integer *n, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCONVF", &i__1); + xerbla_("DSYCONVF", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyconvf_rook.c b/src/map/lapack2flamec/f2c/c/dsyconvf_rook.c index 228cc194c..16d9e5eba 100644 --- a/src/map/lapack2flamec/f2c/c/dsyconvf_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsyconvf_rook.c @@ -201,7 +201,7 @@ int dsyconvf_rook_(char *uplo, char *way, integer *n, doublereal *a, integer *ld int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -248,7 +248,7 @@ int dsyconvf_rook_(char *uplo, char *way, integer *n, doublereal *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("DSYCONVF_ROOK", &i__1); + xerbla_("DSYCONVF_ROOK", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyequb.c b/src/map/lapack2flamec/f2c/c/dsyequb.c index 6adfa4d59..1c3cc92ad 100644 --- a/src/map/lapack2flamec/f2c/c/dsyequb.c +++ b/src/map/lapack2flamec/f2c/c/dsyequb.c @@ -141,7 +141,7 @@ int dsyequb_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *s doublereal sumsq; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); @@ -190,7 +190,7 @@ int dsyequb_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *s if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEQUB", &i__1); + xerbla_("DSYEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyev.c b/src/map/lapack2flamec/f2c/c/dsyev.c index 65b742d89..5932f1e20 100644 --- a/src/map/lapack2flamec/f2c/c/dsyev.c +++ b/src/map/lapack2flamec/f2c/c/dsyev.c @@ -154,7 +154,7 @@ int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a, integer *lda, doub doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -238,7 +238,7 @@ int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a, integer *lda, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEV ", &i__1); + xerbla_("DSYEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyev_2stage.c b/src/map/lapack2flamec/f2c/c/dsyev_2stage.c index 6acd9f69b..95e49ef02 100644 --- a/src/map/lapack2flamec/f2c/c/dsyev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsyev_2stage.c @@ -211,7 +211,7 @@ int dsyev_2stage_(char *jobz, char *uplo, integer *n, doublereal *a, integer *ld int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -288,7 +288,7 @@ int dsyev_2stage_(char *jobz, char *uplo, integer *n, doublereal *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEV_2STAGE ", &i__1); + xerbla_("DSYEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevd.c b/src/map/lapack2flamec/f2c/c/dsyevd.c index 0d04cff93..0d093cdcd 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevd.c +++ b/src/map/lapack2flamec/f2c/c/dsyevd.c @@ -206,7 +206,7 @@ int dsyevd_(char *jobz, char *uplo, integer *n, doublereal * a, integer *lda, do doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -309,7 +309,7 @@ int dsyevd_(char *jobz, char *uplo, integer *n, doublereal * a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVD", &i__1); + xerbla_("DSYEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevd_2stage.c b/src/map/lapack2flamec/f2c/c/dsyevd_2stage.c index 7ace06be2..5514525c6 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsyevd_2stage.c @@ -256,7 +256,7 @@ int dsyevd_2stage_(char *jobz, char *uplo, integer *n, doublereal *a, integer *l int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlacpy_( char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -358,7 +358,7 @@ int dsyevd_2stage_(char *jobz, char *uplo, integer *n, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVD_2STAGE", &i__1); + xerbla_("DSYEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevr.c b/src/map/lapack2flamec/f2c/c/dsyevr.c index 14178e926..8f10b6538 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevr.c +++ b/src/map/lapack2flamec/f2c/c/dsyevr.c @@ -357,7 +357,7 @@ int dsyevr_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, inte doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -497,7 +497,7 @@ int dsyevr_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVR", &i__1); + xerbla_("DSYEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevr_2stage.c b/src/map/lapack2flamec/f2c/c/dsyevr_2stage.c index ec5e6292d..8cf872235 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevr_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsyevr_2stage.c @@ -414,7 +414,7 @@ int dsyevr_2stage_(char *jobz, char *range, char *uplo, integer *n, doublereal * doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -551,7 +551,7 @@ int dsyevr_2stage_(char *jobz, char *range, char *uplo, integer *n, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVR_2STAGE", &i__1); + xerbla_("DSYEVR_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevx.c b/src/map/lapack2flamec/f2c/c/dsyevx.c index 3c772f5e1..168d6c7b8 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevx.c +++ b/src/map/lapack2flamec/f2c/c/dsyevx.c @@ -275,7 +275,7 @@ int dsyevx_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, inte doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -333,6 +333,7 @@ int dsyevx_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, inte indeig = lsame_(range, "I"); lquery = *lwork == -1; *info = 0; + lwkopt = 0; if (! (wantz || lsame_(jobz, "N"))) { *info = -1; @@ -410,7 +411,7 @@ int dsyevx_(char *jobz, char *range, char *uplo, integer *n, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVX", &i__1); + xerbla_("DSYEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyevx_2stage.c b/src/map/lapack2flamec/f2c/c/dsyevx_2stage.c index fcd2a57a2..b64c10f10 100644 --- a/src/map/lapack2flamec/f2c/c/dsyevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsyevx_2stage.c @@ -336,7 +336,7 @@ int dsyevx_2stage_(char *jobz, char *range, char *uplo, integer *n, doublereal * int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -467,7 +467,7 @@ int dsyevx_2stage_(char *jobz, char *range, char *uplo, integer *n, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYEVX_2STAGE", &i__1); + xerbla_("DSYEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsygv.c b/src/map/lapack2flamec/f2c/c/dsygv.c index ccc13164d..15bdd132e 100644 --- a/src/map/lapack2flamec/f2c/c/dsygv.c +++ b/src/map/lapack2flamec/f2c/c/dsygv.c @@ -189,7 +189,7 @@ int dsygv_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *a, i int dsyev_(char *, char *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dpotrf_(char *, integer *, doublereal *, integer *, integer *); @@ -277,7 +277,7 @@ int dsygv_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGV ", &i__1); + xerbla_("DSYGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsygv_2stage.c b/src/map/lapack2flamec/f2c/c/dsygv_2stage.c index ea2aad31a..6a39afb84 100644 --- a/src/map/lapack2flamec/f2c/c/dsygv_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsygv_2stage.c @@ -245,7 +245,7 @@ int dsygv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, doublereal integer lwtrd; logical wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dpotrf_( char *, integer *, doublereal *, integer *, integer *), dsygst_(integer *, char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpotrf_( char *, integer *, doublereal *, integer *, integer *), dsygst_(integer *, char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -322,7 +322,7 @@ int dsygv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGV_2STAGE ", &i__1); + xerbla_("DSYGV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsygvd.c b/src/map/lapack2flamec/f2c/c/dsygvd.c index 52bf1e382..c80e92dad 100644 --- a/src/map/lapack2flamec/f2c/c/dsygvd.c +++ b/src/map/lapack2flamec/f2c/c/dsygvd.c @@ -240,7 +240,7 @@ int dsygvd_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *a, int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper, wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dpotrf_( char *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dpotrf_( char *, integer *, doublereal *, integer *, integer *); integer liwmin; extern /* Subroutine */ int dsyevd_(char *, char *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, integer *, integer *), dsygst_(integer *, char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -340,7 +340,7 @@ int dsygvd_(integer *itype, char *jobz, char *uplo, integer * n, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGVD", &i__1); + xerbla_("DSYGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsygvx.c b/src/map/lapack2flamec/f2c/c/dsygvx.c index a9a440d13..e48ddf1ac 100644 --- a/src/map/lapack2flamec/f2c/c/dsygvx.c +++ b/src/map/lapack2flamec/f2c/c/dsygvx.c @@ -300,7 +300,7 @@ int dsygvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper, wantz, alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dpotrf_(char *, integer *, doublereal *, integer *, integer *); @@ -430,7 +430,7 @@ int dsygvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("DSYGVX", &i__1); + xerbla_("DSYGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyrfs.c b/src/map/lapack2flamec/f2c/c/dsyrfs.c index c16dcc131..3e1a3d523 100644 --- a/src/map/lapack2flamec/f2c/c/dsyrfs.c +++ b/src/map/lapack2flamec/f2c/c/dsyrfs.c @@ -205,7 +205,7 @@ int dsyrfs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -284,7 +284,7 @@ int dsyrfs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYRFS", &i__1); + xerbla_("DSYRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsyrfsx.c b/src/map/lapack2flamec/f2c/c/dsyrfsx.c index 45c5bf00c..777610fdc 100644 --- a/src/map/lapack2flamec/f2c/c/dsyrfsx.c +++ b/src/map/lapack2flamec/f2c/c/dsyrfsx.c @@ -422,7 +422,7 @@ int dsyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublereal *a, logical rcequ; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlansy_(char *, char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int dsycon_(char *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); @@ -573,7 +573,7 @@ int dsyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYRFSX", &i__1); + xerbla_("DSYRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysv.c b/src/map/lapack2flamec/f2c/c/dsysv.c index 94306ce50..e8d285862 100644 --- a/src/map/lapack2flamec/f2c/c/dsysv.c +++ b/src/map/lapack2flamec/f2c/c/dsysv.c @@ -169,7 +169,7 @@ int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, i /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), dsytrf_( char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dsytrf_( char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -245,7 +245,7 @@ int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSV ", &i__1); + xerbla_("DSYSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysv_aa.c b/src/map/lapack2flamec/f2c/c/dsysv_aa.c index 6a493ac8c..90f91d3b2 100644 --- a/src/map/lapack2flamec/f2c/c/dsysv_aa.c +++ b/src/map/lapack2flamec/f2c/c/dsysv_aa.c @@ -163,7 +163,7 @@ int dsysv_aa_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda extern logical lsame_(char *, char *); integer lwkopt_sytrf__, lwkopt_sytrs__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -239,7 +239,7 @@ int dsysv_aa_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSV_AA ", &i__1); + xerbla_("DSYSV_AA ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/dsysv_aa_2stage.c index 1b07f083c..e4af3592b 100644 --- a/src/map/lapack2flamec/f2c/c/dsysv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsysv_aa_2stage.c @@ -189,7 +189,7 @@ int dsysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublereal *a, integ extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -263,7 +263,7 @@ int dsysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublereal *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSV_AA_2STAGE", &i__1); + xerbla_("DSYSV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysv_rk.c b/src/map/lapack2flamec/f2c/c/dsysv_rk.c index 1da2561b8..8eaee45f1 100644 --- a/src/map/lapack2flamec/f2c/c/dsysv_rk.c +++ b/src/map/lapack2flamec/f2c/c/dsysv_rk.c @@ -229,7 +229,7 @@ int dsysv_rk_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda int dsytrs_3_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dsytrf_rk_(char *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.7.0) -- */ @@ -304,7 +304,7 @@ int dsysv_rk_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSV_RK ", &i__1); + xerbla_("DSYSV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysv_rook.c b/src/map/lapack2flamec/f2c/c/dsysv_rook.c index b164b4c07..96eac7990 100644 --- a/src/map/lapack2flamec/f2c/c/dsysv_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsysv_rook.c @@ -203,7 +203,7 @@ int dsysv_rook_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *l int dsytrf_rook_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dsytrs_rook_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.1) -- */ @@ -277,7 +277,7 @@ int dsysv_rook_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSV_ROOK ", &i__1); + xerbla_("DSYSV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysvx.c b/src/map/lapack2flamec/f2c/c/dsysvx.c index c0a5b4f44..6f3c430fb 100644 --- a/src/map/lapack2flamec/f2c/c/dsysvx.c +++ b/src/map/lapack2flamec/f2c/c/dsysvx.c @@ -285,7 +285,7 @@ int dsysvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, i extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal dlansy_(char *, char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ @@ -398,7 +398,7 @@ int dsysvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSVX", &i__1); + xerbla_("DSYSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsysvxx.c b/src/map/lapack2flamec/f2c/c/dsysvxx.c index 54b3339dc..ad7c27cda 100644 --- a/src/map/lapack2flamec/f2c/c/dsysvxx.c +++ b/src/map/lapack2flamec/f2c/c/dsysvxx.c @@ -516,7 +516,7 @@ int dsysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer infequ; extern /* Subroutine */ @@ -666,7 +666,7 @@ int dsysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYSVXX", &i__1); + xerbla_("DSYSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytf2.c b/src/map/lapack2flamec/f2c/c/dsytf2.c index 44ee746b8..c5be4a395 100644 --- a/src/map/lapack2flamec/f2c/c/dsytf2.c +++ b/src/map/lapack2flamec/f2c/c/dsytf2.c @@ -209,7 +209,7 @@ int dsytf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, extern integer idamax_(integer *, doublereal *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax, rowmax; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,6 +240,7 @@ int dsytf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -255,7 +256,7 @@ int dsytf2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTF2", &i__1); + xerbla_("DSYTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytf2_rk.c b/src/map/lapack2flamec/f2c/c/dsytf2_rk.c index d1da31c36..54f244f5a 100644 --- a/src/map/lapack2flamec/f2c/c/dsytf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/dsytf2_rk.c @@ -262,7 +262,7 @@ int dsytf2_rk_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * doublereal absakk; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax, rowmax; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -294,6 +294,8 @@ int dsytf2_rk_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -309,7 +311,7 @@ int dsytf2_rk_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTF2_RK", &i__1); + xerbla_("DSYTF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytf2_rook.c b/src/map/lapack2flamec/f2c/c/dsytf2_rook.c index 598b0e7e0..1785e9e88 100644 --- a/src/map/lapack2flamec/f2c/c/dsytf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsytf2_rook.c @@ -212,7 +212,7 @@ int dsytf2_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i doublereal absakk; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax, rowmax; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -243,6 +243,8 @@ int dsytf2_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -258,7 +260,7 @@ int dsytf2_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTF2_ROOK", &i__1); + xerbla_("DSYTF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrd_2stage.c b/src/map/lapack2flamec/f2c/c/dsytrd_2stage.c index 5c46b43d7..393ab7dc7 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsytrd_2stage.c @@ -236,9 +236,9 @@ int dsytrd_2stage_(char *vect, char *uplo, integer *n, doublereal *a, integer *l int dsytrd_sy2sb_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); extern logical lsame_(char *, char *); integer abpos, lhmin, lwmin; - logical wantq, upper; + logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -269,7 +269,6 @@ int dsytrd_2stage_(char *vect, char *uplo, integer *n, doublereal *a, integer *l --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "V"); upper = lsame_(uplo, "U"); lquery = *lwork == -1 || *lhous2 == -1; /* Determine the block size, the workspace size and the hous size. */ @@ -311,7 +310,7 @@ int dsytrd_2stage_(char *vect, char *uplo, integer *n, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD_2STAGE", &i__1); + xerbla_("DSYTRD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -336,7 +335,7 @@ int dsytrd_2stage_(char *vect, char *uplo, integer *n, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD_SY2SB", &i__1); + xerbla_("DSYTRD_SY2SB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -344,7 +343,7 @@ int dsytrd_2stage_(char *vect, char *uplo, integer *n, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD_SB2ST", &i__1); + xerbla_("DSYTRD_SB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrd_sb2st.c b/src/map/lapack2flamec/f2c/c/dsytrd_sb2st.c index 740357750..b1fce291c 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrd_sb2st.c +++ b/src/map/lapack2flamec/f2c/c/dsytrd_sb2st.c @@ -1,6 +1,9 @@ /* ../netlib/v3.9.0/dsytrd_sb2st.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#ifdef FLA_OPENMP_MULTITHREADING +#include +#endif static integer c__2 = 2; static integer c_n1 = -1; static integer c__3 = 3; @@ -64,7 +67,7 @@ static doublereal c_b26 = 0.; /* > VECT is CHARACTER*1 */ /* > = 'N': No need for the Housholder representation, */ /* > and thus LHOUS is of size fla_max(1, 4*N); -*/ + */ /* > = 'V': the Householder representation is needed to */ /* > either generate or to apply Q later on, */ /* > then LHOUS is to be queried and computed. */ @@ -75,7 +78,7 @@ static doublereal c_b26 = 0.; /* > \verbatim */ /* > UPLO is CHARACTER*1 */ /* > = 'U': Upper triangle of A is stored; -*/ + */ /* > = 'L': Lower triangle of A is stored. */ /* > \endverbatim */ /* > */ @@ -100,7 +103,7 @@ static doublereal c_b26 = 0.; /* > j-th column of A is stored in the j-th column of the array AB */ /* > as follows: */ /* > if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for fla_max(1,j-kd)<=i<=j; -*/ + */ /* > if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=fla_min(n,j+kd). */ /* > On exit, the diagonal elements of AB are overwritten by the */ /* > diagonal elements of the tridiagonal matrix T; @@ -227,33 +230,37 @@ the routine */ /* > */ /* ===================================================================== */ /* Subroutine */ -int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, doublereal *ab, integer *ldab, doublereal * d__, doublereal *e, doublereal *hous, integer *lhous, doublereal * work, integer *lwork, integer *info) +int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, doublereal *ab, integer *ldab, doublereal *d__, doublereal *e, doublereal *hous, integer *lhous, doublereal *work, integer *lwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT - AOCL_DTL_SNPRINTF("dsytrd_sb2st inputs: stage1 %c, vect %c, uplo %c, n %" FLA_IS ", kd %" FLA_IS ", ldab %" FLA_IS ", lhous %" FLA_IS ", lwork %" FLA_IS "",*stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); + AOCL_DTL_SNPRINTF("dsytrd_sb2st inputs: stage1 %c, vect %c, uplo %c, n %" FLA_IS ", kd %" FLA_IS ", ldab %" FLA_IS ", lhous %" FLA_IS ", lwork %" FLA_IS "", *stage1, *vect, *uplo, *n, *kd, *ldab, *lhous, *lwork); /* System generated locals */ integer ab_dim1, ab_offset, i__1, i__2, i__3, i__4, i__5; /* Local variables */ - integer abofdpos, nthreads, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv, stt, inda; + integer abofdpos, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv, stt, inda; extern integer ilaenv2stage_(integer *, char *, char *, integer *, integer *, integer *, integer *); - integer thed, indv, myid, indw, apos, dpos, edind, debug; + integer thed, indv, myid, indw, apos, dpos, edind; extern logical lsame_(char *, char *); - integer lhmin, sidev, sizea, shift, stind, colpt, lwmin, awpos; + integer lhmin, sizea, shift, stind, colpt, lwmin, awpos; logical wantq, upper; integer grsiz, ttype, abdpos; + int nthreads; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int + dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), + dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), + xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer thgrid; extern /* Subroutine */ - int dsb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); + int + dsb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); +#ifdef FLA_OPENMP_MULTITHREADING + extern /* Function */ + int fla_thread_get_num_threads(); +#endif integer thgrnb, indtau, ofdpos; logical lquery, afters1; - extern /* Subroutine */ - int f90_exit_(void); integer ceiltmp, sweepid, nbtiles, sizetau, thgrsiz; - /* #if defined(_OPENMP) */ - /* use omp_lib */ - /* #endif */ /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -285,7 +292,6 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, --hous; --work; /* Function Body */ - debug = 0; *info = 0; afters1 = lsame_(stage1, "Y"); wantq = lsame_(vect, "V"); @@ -295,15 +301,15 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ib = ilaenv2stage_(&c__2, "DSYTRD_SB2ST", vect, n, kd, &c_n1, &c_n1); lhmin = ilaenv2stage_(&c__3, "DSYTRD_SB2ST", vect, n, kd, &ib, &c_n1); lwmin = ilaenv2stage_(&c__4, "DSYTRD_SB2ST", vect, n, kd, &ib, &c_n1); - if (! afters1 && ! lsame_(stage1, "N")) + if (!afters1 && !lsame_(stage1, "N")) { *info = -1; } - else if (! lsame_(vect, "N")) + else if (!lsame_(vect, "N")) { *info = -2; } - else if (! upper && ! lsame_(uplo, "L")) + else if (!upper && !lsame_(uplo, "L")) { *info = -3; } @@ -319,23 +325,23 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { *info = -7; } - else if (*lhous < lhmin && ! lquery) + else if (*lhous < lhmin && !lquery) { *info = -11; } - else if (*lwork < lwmin && ! lquery) + else if (*lwork < lwmin && !lquery) { *info = -13; } if (*info == 0) { - hous[1] = (doublereal) lhmin; - work[1] = (doublereal) lwmin; + hous[1] = (doublereal)lhmin; + work[1] = (doublereal)lwmin; } if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD_SB2ST", &i__1); + xerbla_("DSYTRD_SB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -355,14 +361,12 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, /* Determine pointer position */ ldv = *kd + ib; sizetau = *n << 1; - sidev = *n << 1; indtau = 1; indv = indtau + sizetau; lda = (*kd << 1) + 1; sizea = lda * *n; inda = 1; indw = inda + sizea; - nthreads = 1; tid = 0; if (upper) { @@ -391,16 +395,16 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = ab[abdpos + i__ * ab_dim1]; /* L30: */ } i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = 0.; /* L40: */ @@ -423,8 +427,8 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = ab[abdpos + i__ * ab_dim1]; /* L50: */ @@ -433,8 +437,8 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = ab[abofdpos + (i__ + 1) * ab_dim1]; /* L60: */ @@ -444,8 +448,8 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = ab[abofdpos + i__ * ab_dim1]; /* L70: */ @@ -483,137 +487,137 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ++thgrnb; } i__1 = *kd + 1; - dlacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda) ; + dlacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda); dlaset_("A", kd, n, &c_b26, &c_b26, &work[awpos], &lda); + /* openMP parallelisation start here */ - /* #if defined(_OPENMP) */ - /* !$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND ) */ - /* !$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) */ - /* !$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND ) */ - /* !$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK) */ - /* !$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA ) */ - /* !$OMP$ SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT ) */ - /* !$OMP MASTER */ - /* #endif */ - /* main bulge chasing loop */ - i__1 = thgrnb; - for (thgrid = 1; - thgrid <= i__1; - ++thgrid) + nthreads = 1; +#ifdef FLA_OPENMP_MULTITHREADING + nthreads = fla_thread_get_num_threads(); +#pragma omp parallel num_threads(nthreads) private(tid, thgrid, blklastind) \ + private(thed, i__, m, k, st, ed, stt, sweepid, myid, ttype, colpt, stind, edind) \ + shared(uplo, wantq, indv, indtau, hous, work, \ + n, kd, ib, nbtiles, lda, ldv, inda, stepercol, thgrnb, thgrsiz, grsiz, shift) { - stt = (thgrid - 1) * thgrsiz + 1; - /* Computing MIN */ - i__2 = stt + thgrsiz - 1; - i__3 = *n - 1; // , expr subst - thed = fla_min(i__2,i__3); - i__2 = *n - 1; - for (i__ = stt; - i__ <= i__2; - ++i__) +#pragma omp master { - ed = fla_min(i__,thed); - if (stt > ed) - { - break; - } - i__3 = stepercol; - for (m = 1; - m <= i__3; - ++m) +#endif + /* main bulge chasing loop */ + i__1 = thgrnb; + for (thgrid = 1; + thgrid <= i__1; + ++thgrid) { - st = stt; - i__4 = ed; - for (sweepid = st; - sweepid <= i__4; - ++sweepid) + stt = (thgrid - 1) * thgrsiz + 1; + /* Computing MIN */ + i__2 = stt + thgrsiz - 1; + i__3 = *n - 1; // , expr subst + thed = fla_min(i__2, i__3); + i__2 = *n - 1; + for (i__ = stt; + i__ <= i__2; + ++i__) { - i__5 = grsiz; - for (k = 1; - k <= i__5; - ++k) + ed = fla_min(i__, thed); + if (stt > ed) { - myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; - if (myid == 1) - { - ttype = 1; - } - else - { - ttype = myid % 2 + 2; - } - if (ttype == 2) - { - colpt = myid / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - blklastind = colpt; - } - else + break; + } + i__3 = stepercol; + for (m = 1; + m <= i__3; + ++m) + { + st = stt; + i__4 = ed; + for (sweepid = st; + sweepid <= i__4; + ++sweepid) { - colpt = (myid + 1) / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - if (stind >= edind - 1 && edind == *n) - { - blklastind = *n; - } - else + i__5 = grsiz; + for (k = 1; + k <= i__5; + ++k) { - blklastind = 0; + myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; + if (myid == 1) + { + ttype = 1; + } + else + { + ttype = myid % 2 + 2; + } + if (ttype == 2) + { + colpt = myid / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + blklastind = colpt; + } + else + { + colpt = (myid + 1) / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + if (stind >= edind - 1 && edind == *n) + { + blklastind = *n; + } + else + { + blklastind = 0; + } + } + /* Call the kernel */ +#ifdef FLA_OPENMP_MULTITHREADING + if (ttype != 1) + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(in : work[myid - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + dsb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } + else + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + dsb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } +#else + dsb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); +#endif + if (blklastind >= *n - 1) + { + ++stt; + break; + } + /* L140: */ } + /* L130: */ } - /* Call the kernel */ - /* #if defined(_OPENMP) */ - /* IF( TTYPE.NE.1 ) THEN */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(in:WORK(MYID-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ELSE */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ENDIF */ - /* #else */ - dsb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, & hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); - /* #endif */ - if (blklastind >= *n - 1) - { - ++stt; - break; - } - /* L140: */ + /* L120: */ } - /* L130: */ + /* L110: */ } - /* L120: */ + /* L100: */ } - /* L110: */ - } - /* L100: */ - } - /* #if defined(_OPENMP) */ - /* !$OMP END MASTER */ - /* !$OMP END PARALLEL */ - /* #endif */ +#ifdef FLA_OPENMP_MULTITHREADING + } /* End OMP Master */ + } /* End OMP Parallel */ +#endif /* Copy the diagonal from A to D. Note that D is REAL thus only */ /* the Real part is needed, the imaginary part should be zero. */ i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = work[dpos + (i__ - 1) * lda]; /* L150: */ @@ -624,8 +628,8 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = work[ofdpos + i__ * lda]; /* L160: */ @@ -635,18 +639,17 @@ int dsytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = work[ofdpos + (i__ - 1) * lda]; /* L170: */ } } - hous[1] = (doublereal) lhmin; - work[1] = (doublereal) lwmin; + hous[1] = (doublereal)lhmin; + work[1] = (doublereal)lwmin; AOCL_DTL_TRACE_LOG_EXIT return 0; /* End of DSYTRD_SB2ST */ } /* dsytrd_sb2st__ */ - diff --git a/src/map/lapack2flamec/f2c/c/dsytrd_sy2sb.c b/src/map/lapack2flamec/f2c/c/dsytrd_sy2sb.c index 28a6ebba4..503201bd9 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrd_sy2sb.c +++ b/src/map/lapack2flamec/f2c/c/dsytrd_sy2sb.c @@ -261,7 +261,7 @@ int dsytrd_sy2sb_(char *uplo, integer *n, integer *kd, doublereal *a, integer *l int dsymm_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dsyr2k_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgelqf_( integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); + int dsyr2k_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dgelqf_( integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -332,7 +332,7 @@ int dsytrd_sy2sb_(char *uplo, integer *n, integer *kd, doublereal *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD_SY2SB", &i__1); + xerbla_("DSYTRD_SY2SB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrf.c b/src/map/lapack2flamec/f2c/c/dsytrf.c index 0e600cfaa..c471fd97a 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrf.c +++ b/src/map/lapack2flamec/f2c/c/dsytrf.c @@ -186,7 +186,7 @@ int dsytrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int dsytf2_(char *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *); + int dsytf2_(char *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlasyf_(char *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); @@ -247,7 +247,7 @@ int dsytrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRF", &i__1); + xerbla_("DSYTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrf_aa.c b/src/map/lapack2flamec/f2c/c/dsytrf_aa.c index 25b91c912..9dd5422bf 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/dsytrf_aa.c @@ -144,7 +144,7 @@ int dsytrf_aa_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipi int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -209,7 +209,7 @@ int dsytrf_aa_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRF_AA", &i__1); + xerbla_("DSYTRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/dsytrf_aa_2stage.c index 8fbf7a17a..6c5743489 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsytrf_aa_2stage.c @@ -173,7 +173,7 @@ int dsytrf_aa_2stage_(char *uplo, integer *n, doublereal *a, integer *lda, doubl int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dgbtrf_(integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, integer *), dgetrf_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dsygst_(integer *, char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -234,7 +234,7 @@ int dsytrf_aa_2stage_(char *uplo, integer *n, doublereal *a, integer *lda, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRF_AA_2STAGE", &i__1); + xerbla_("DSYTRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrf_rk.c b/src/map/lapack2flamec/f2c/c/dsytrf_rk.c index 50a2ae42c..acc8d1720 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/dsytrf_rk.c @@ -267,7 +267,7 @@ int dsytrf_rk_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -327,7 +327,7 @@ int dsytrf_rk_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRF_RK", &i__1); + xerbla_("DSYTRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrf_rook.c b/src/map/lapack2flamec/f2c/c/dsytrf_rook.c index 02f15f0ef..a0e00a51c 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsytrf_rook.c @@ -212,7 +212,7 @@ int dsytrf_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -274,7 +274,7 @@ int dsytrf_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRF_ROOK", &i__1); + xerbla_("DSYTRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri.c b/src/map/lapack2flamec/f2c/c/dsytri.c index cfdc598e2..1d9f9fd02 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri.c +++ b/src/map/lapack2flamec/f2c/c/dsytri.c @@ -128,7 +128,7 @@ int dsytri_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, integer kstep; logical upper; extern /* Subroutine */ - int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -174,7 +174,7 @@ int dsytri_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI", &i__1); + xerbla_("DSYTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri2.c b/src/map/lapack2flamec/f2c/c/dsytri2.c index 1fafc10cc..b8396bf77 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri2.c +++ b/src/map/lapack2flamec/f2c/c/dsytri2.c @@ -133,7 +133,7 @@ int dsytri2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dsytri_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); @@ -196,7 +196,7 @@ int dsytri2_(char *uplo, integer *n, doublereal *a, integer * lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI2", &i__1); + xerbla_("DSYTRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri2x.c b/src/map/lapack2flamec/f2c/c/dsytri2x.c index 26568c8da..067e23e36 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri2x.c +++ b/src/map/lapack2flamec/f2c/c/dsytri2x.c @@ -138,7 +138,7 @@ int dsytri2x_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipiv logical upper; doublereal u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), dtrtri_( char *, char *, integer *, doublereal *, integer *, integer *), dsyconv_(char *, char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtrtri_( char *, char *, integer *, doublereal *, integer *, integer *), dsyconv_(char *, char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); doublereal u01_ip1_j__, u11_ip1_j__; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -188,7 +188,7 @@ int dsytri2x_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipiv if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI2X", &i__1); + xerbla_("DSYTRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri_3.c b/src/map/lapack2flamec/f2c/c/dsytri_3.c index 1ed7ae737..486e597c6 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri_3.c +++ b/src/map/lapack2flamec/f2c/c/dsytri_3.c @@ -176,7 +176,7 @@ int dsytri_3_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *e extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -235,7 +235,7 @@ int dsytri_3_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI_3", &i__1); + xerbla_("DSYTRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri_3x.c b/src/map/lapack2flamec/f2c/c/dsytri_3x.c index 1b6c2113b..a17cbb847 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri_3x.c +++ b/src/map/lapack2flamec/f2c/c/dsytri_3x.c @@ -176,7 +176,7 @@ int dsytri_3x_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * logical upper; doublereal u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int dtrtri_(char *, char *, integer *, doublereal *, integer *, integer *); @@ -230,7 +230,7 @@ int dsytri_3x_(char *uplo, integer *n, doublereal *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI_3X", &i__1); + xerbla_("DSYTRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytri_rook.c b/src/map/lapack2flamec/f2c/c/dsytri_rook.c index f1a34c895..9ddf4236f 100644 --- a/src/map/lapack2flamec/f2c/c/dsytri_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsytri_rook.c @@ -142,7 +142,7 @@ int dsytri_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i integer kstep; logical upper; extern /* Subroutine */ - int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -188,7 +188,7 @@ int dsytri_rook_(char *uplo, integer *n, doublereal *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRI_ROOK", &i__1); + xerbla_("DSYTRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs.c b/src/map/lapack2flamec/f2c/c/dsytrs.c index 038119ad1..a56d97ce0 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs.c @@ -134,7 +134,7 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -189,7 +189,7 @@ int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS", &i__1); + xerbla_("DSYTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs2.c b/src/map/lapack2flamec/f2c/c/dsytrs2.c index f41b9c685..7c01e825b 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs2.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs2.c @@ -141,7 +141,7 @@ int dsytrs2_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, int dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), dsyconv_( char *, char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dsyconv_( char *, char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -197,7 +197,7 @@ int dsytrs2_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS2", &i__1); + xerbla_("DSYTRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs_3.c b/src/map/lapack2flamec/f2c/c/dsytrs_3.c index 0b109d6fa..b9b24a6ca 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs_3.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs_3.c @@ -174,7 +174,7 @@ int dsytrs_3_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda int dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -230,7 +230,7 @@ int dsytrs_3_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS_3", &i__1); + xerbla_("DSYTRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs_aa.c b/src/map/lapack2flamec/f2c/c/dsytrs_aa.c index 83636ca2f..b765d84cc 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs_aa.c @@ -133,7 +133,7 @@ int dsytrs_aa_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *ld int dswap_(integer *, doublereal *, integer *, doublereal *, integer *), dgtsv_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -201,7 +201,7 @@ int dsytrs_aa_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS_AA", &i__1); + xerbla_("DSYTRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/dsytrs_aa_2stage.c index d6d951e45..4a1dbd116 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs_aa_2stage.c @@ -143,7 +143,7 @@ int dsytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublereal *a, inte int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), dgbtrs_( char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dgbtrs_( char *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaswp_(integer *, doublereal *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -203,7 +203,7 @@ int dsytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS_AA_2STAGE", &i__1); + xerbla_("DSYTRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dsytrs_rook.c b/src/map/lapack2flamec/f2c/c/dsytrs_rook.c index 22624e424..816cfecd9 100644 --- a/src/map/lapack2flamec/f2c/c/dsytrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/dsytrs_rook.c @@ -148,7 +148,7 @@ int dsytrs_rook_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer * int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -203,7 +203,7 @@ int dsytrs_rook_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRS_ROOK", &i__1); + xerbla_("DSYTRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtbcon.c b/src/map/lapack2flamec/f2c/c/dtbcon.c index 4d1233ba4..b48e6c107 100644 --- a/src/map/lapack2flamec/f2c/c/dtbcon.c +++ b/src/map/lapack2flamec/f2c/c/dtbcon.c @@ -157,7 +157,7 @@ int dtbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, doubler extern integer idamax_(integer *, doublereal *, integer *); extern doublereal dlantb_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlatbs_(char *, char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlatbs_(char *, char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; logical onenrm; char normin[1]; @@ -224,7 +224,7 @@ int dtbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, doubler if (*info != 0) { i__1 = -(*info); - xerbla_("DTBCON", &i__1); + xerbla_("DTBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtbrfs.c b/src/map/lapack2flamec/f2c/c/dtbrfs.c index 2f1e70c35..15ad84d69 100644 --- a/src/map/lapack2flamec/f2c/c/dtbrfs.c +++ b/src/map/lapack2flamec/f2c/c/dtbrfs.c @@ -203,7 +203,7 @@ int dtbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -289,7 +289,7 @@ int dtbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DTBRFS", &i__1); + xerbla_("DTBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtbtrs.c b/src/map/lapack2flamec/f2c/c/dtbtrs.c index 20b6c4cb8..7c5bda451 100644 --- a/src/map/lapack2flamec/f2c/c/dtbtrs.c +++ b/src/map/lapack2flamec/f2c/c/dtbtrs.c @@ -149,7 +149,7 @@ int dtbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege int dtbsv_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -218,7 +218,7 @@ int dtbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DTBTRS", &i__1); + xerbla_("DTBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtfsm.c b/src/map/lapack2flamec/f2c/c/dtfsm.c index 11f2b373d..ecd4789cc 100644 --- a/src/map/lapack2flamec/f2c/c/dtfsm.c +++ b/src/map/lapack2flamec/f2c/c/dtfsm.c @@ -282,7 +282,7 @@ int dtfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical misodd, nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -351,7 +351,7 @@ int dtfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege if (info != 0) { i__1 = -info; - xerbla_("DTFSM ", &i__1); + xerbla_("DTFSM ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtftri.c b/src/map/lapack2flamec/f2c/c/dtftri.c index f05a17c66..a466eb596 100644 --- a/src/map/lapack2flamec/f2c/c/dtftri.c +++ b/src/map/lapack2flamec/f2c/c/dtftri.c @@ -211,7 +211,7 @@ int dtftri_(char *transr, char *uplo, char *diag, integer *n, doublereal *a, int int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int dtrtri_(char *, char *, integer *, doublereal *, integer *, integer *); @@ -258,7 +258,7 @@ int dtftri_(char *transr, char *uplo, char *diag, integer *n, doublereal *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("DTFTRI", &i__1); + xerbla_("DTFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtfttp.c b/src/map/lapack2flamec/f2c/c/dtfttp.c index 0607d5f94..5ea145264 100644 --- a/src/map/lapack2flamec/f2c/c/dtfttp.c +++ b/src/map/lapack2flamec/f2c/c/dtfttp.c @@ -184,12 +184,12 @@ int dtfttp_(char *transr, char *uplo, integer *n, doublereal *arf, doublereal *a /* System generated locals */ integer i__1, i__2, i__3; /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -228,7 +228,7 @@ int dtfttp_(char *transr, char *uplo, integer *n, doublereal *arf, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DTFTTP", &i__1); + xerbla_("DTFTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -252,7 +252,6 @@ int dtfttp_(char *transr, char *uplo, integer *n, doublereal *arf, doublereal *a return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/dtfttr.c b/src/map/lapack2flamec/f2c/c/dtfttr.c index 32e8bfac6..5a285c297 100644 --- a/src/map/lapack2flamec/f2c/c/dtfttr.c +++ b/src/map/lapack2flamec/f2c/c/dtfttr.c @@ -195,7 +195,7 @@ int dtfttr_(char *transr, char *uplo, integer *n, doublereal *arf, doublereal *a extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -244,7 +244,7 @@ int dtfttr_(char *transr, char *uplo, integer *n, doublereal *arf, doublereal *a if (*info != 0) { i__1 = -(*info); - xerbla_("DTFTTR", &i__1); + xerbla_("DTFTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgevc.c b/src/map/lapack2flamec/f2c/c/dtgevc.c index ccd13e9a6..4bd1e3cbc 100644 --- a/src/map/lapack2flamec/f2c/c/dtgevc.c +++ b/src/map/lapack2flamec/f2c/c/dtgevc.c @@ -1,4 +1,4 @@ -/* ../netlib/dtgevc.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; +/*../netlib/dtgevc.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ static logical c_true = TRUE_; @@ -342,7 +342,7 @@ int dtgevc_(char *side, char *howmny, logical *select, integer *n, doublereal *s int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal xscale, bignum; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical ilcomp, ilcplx; integer ihwmny; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -384,6 +384,7 @@ int dtgevc_(char *side, char *howmny, logical *select, integer *n, doublereal *s vr -= vr_offset; --work; /* Function Body */ + ilback = FALSE_; if (lsame_(howmny, "A")) { ihwmny = 1; @@ -453,7 +454,7 @@ int dtgevc_(char *side, char *howmny, logical *select, integer *n, doublereal *s if (*info != 0) { i__1 = -(*info); - xerbla_("DTGEVC", &i__1); + xerbla_("DTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -548,7 +549,7 @@ int dtgevc_(char *side, char *howmny, logical *select, integer *n, doublereal *s if (*info != 0) { i__1 = -(*info); - xerbla_("DTGEVC", &i__1); + xerbla_("DTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgexc.c b/src/map/lapack2flamec/f2c/c/dtgexc.c index 015890c97..718e38a20 100644 --- a/src/map/lapack2flamec/f2c/c/dtgexc.c +++ b/src/map/lapack2flamec/f2c/c/dtgexc.c @@ -222,7 +222,7 @@ int dtgexc_(logical *wantq, logical *wantz, integer *n, doublereal *a, integer * /* Local variables */ integer nbf, nbl, here, lwmin; extern /* Subroutine */ - int dtgex2_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dtgex2_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer nbnext; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -308,7 +308,7 @@ int dtgexc_(logical *wantq, logical *wantz, integer *n, doublereal *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DTGEXC", &i__1); + xerbla_("DTGEXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgsen.c b/src/map/lapack2flamec/f2c/c/dtgsen.c index 1d170a299..99a72e575 100644 --- a/src/map/lapack2flamec/f2c/c/dtgsen.c +++ b/src/map/lapack2flamec/f2c/c/dtgsen.c @@ -479,7 +479,7 @@ int dtgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte extern doublereal dlamch_(char *); doublereal dscale, rdscal; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dtgexc_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *), dlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtgexc_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *), dlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); integer liwmin; extern /* Subroutine */ int dtgsyl_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *); @@ -558,7 +558,7 @@ int dtgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSEN", &i__1); + xerbla_("DTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -662,7 +662,7 @@ int dtgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSEN", &i__1); + xerbla_("DTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgsja.c b/src/map/lapack2flamec/f2c/c/dtgsja.c index c0e03a7d3..0d4bfcdad 100644 --- a/src/map/lapack2flamec/f2c/c/dtgsja.c +++ b/src/map/lapack2flamec/f2c/c/dtgsja.c @@ -408,7 +408,7 @@ int dtgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer int dlags2_(logical *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlapll_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *); integer kcycle; extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal hugenum; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -450,7 +450,7 @@ int dtgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer q -= q_offset; --work; /* Function Body */ - hugenum = 1.7976931348623157e308f; + hugenum = 1.7976931348623157e308; initu = lsame_(jobu, "I"); wantu = initu || lsame_(jobu, "U"); initv = lsame_(jobv, "I"); @@ -505,7 +505,7 @@ int dtgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSJA", &i__1); + xerbla_("DTGSJA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgsna.c b/src/map/lapack2flamec/f2c/c/dtgsna.c index 51d88e3ff..513d5be4b 100644 --- a/src/map/lapack2flamec/f2c/c/dtgsna.c +++ b/src/map/lapack2flamec/f2c/c/dtgsna.c @@ -417,7 +417,7 @@ int dtgsna_(char *job, char *howmny, logical *select, integer *n, doublereal *a, extern doublereal dlamch_(char *); doublereal alphai, alphar; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dtgexc_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtgexc_(logical *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *, integer *); logical wantbh, wantdf, somcon; doublereal alprqt; extern /* Subroutine */ @@ -472,6 +472,7 @@ int dtgsna_(char *job, char *howmny, logical *select, integer *n, doublereal *a, somcon = lsame_(howmny, "S"); *info = 0; lquery = *lwork == -1; + cond = 0.; if (! wants && ! wantdf) { *info = -1; @@ -577,7 +578,7 @@ int dtgsna_(char *job, char *howmny, logical *select, integer *n, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSNA", &i__1); + xerbla_("DTGSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgsy2.c b/src/map/lapack2flamec/f2c/c/dtgsy2.c index 8f53e3ad1..5974a0b42 100644 --- a/src/map/lapack2flamec/f2c/c/dtgsy2.c +++ b/src/map/lapack2flamec/f2c/c/dtgsy2.c @@ -287,7 +287,7 @@ int dtgsy2_(char *trans, integer *ijob, integer *m, integer * n, doublereal *a, int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dgesc2_(integer *, doublereal *, integer *, doublereal *, integer *, integer *, doublereal *), dgetc2_(integer *, doublereal *, integer *, integer *, integer *, integer *), dlatdf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *); doublereal scaloc; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -387,7 +387,7 @@ int dtgsy2_(char *trans, integer *ijob, integer *m, integer * n, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSY2", &i__1); + xerbla_("DTGSY2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtgsyl.c b/src/map/lapack2flamec/f2c/c/dtgsyl.c index 6313032f4..d97a11b20 100644 --- a/src/map/lapack2flamec/f2c/c/dtgsyl.c +++ b/src/map/lapack2flamec/f2c/c/dtgsyl.c @@ -315,7 +315,7 @@ int dtgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublereal *a, int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer iround; logical notran; integer isolve; @@ -368,6 +368,7 @@ int dtgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublereal *a, *info = 0; notran = lsame_(trans, "N"); lquery = *lwork == -1; + scale2 = 0.; if (! notran && ! lsame_(trans, "T")) { *info = -1; @@ -443,7 +444,7 @@ int dtgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublereal *a, if (*info != 0) { i__1 = -(*info); - xerbla_("DTGSYL", &i__1); + xerbla_("DTGSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpcon.c b/src/map/lapack2flamec/f2c/c/dtpcon.c index 6f5aca87c..ae78191fb 100644 --- a/src/map/lapack2flamec/f2c/c/dtpcon.c +++ b/src/map/lapack2flamec/f2c/c/dtpcon.c @@ -143,7 +143,7 @@ int dtpcon_(char *norm, char *uplo, char *diag, integer *n, doublereal *ap, doub extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlantp_(char *, char *, char *, integer *, doublereal *, doublereal *); doublereal ainvnm; extern /* Subroutine */ @@ -203,7 +203,7 @@ int dtpcon_(char *norm, char *uplo, char *diag, integer *n, doublereal *ap, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DTPCON", &i__1); + xerbla_("DTPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtplqt.c b/src/map/lapack2flamec/f2c/c/dtplqt.c index 2ce04dee4..f9dca8e40 100644 --- a/src/map/lapack2flamec/f2c/c/dtplqt.c +++ b/src/map/lapack2flamec/f2c/c/dtplqt.c @@ -185,7 +185,7 @@ int dtplqt_(integer *m, integer *n, integer *l, integer *mb, doublereal *a, inte /* Local variables */ integer i__, ib, lb, nb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtplqt2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtplqt2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -246,7 +246,7 @@ int dtplqt_(integer *m, integer *n, integer *l, integer *mb, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DTPLQT", &i__1); + xerbla_("DTPLQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtplqt2.c b/src/map/lapack2flamec/f2c/c/dtplqt2.c index 2e34dbc89..1e50dac28 100644 --- a/src/map/lapack2flamec/f2c/c/dtplqt2.c +++ b/src/map/lapack2flamec/f2c/c/dtplqt2.c @@ -180,7 +180,7 @@ int dtplqt2_(integer *m, integer *n, integer *l, doublereal * a, integer *lda, d int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal alpha; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -239,7 +239,7 @@ int dtplqt2_(integer *m, integer *n, integer *l, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DTPLQT2", &i__1); + xerbla_("DTPLQT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpmlqt.c b/src/map/lapack2flamec/f2c/c/dtpmlqt.c index dcbfeb629..962a33942 100644 --- a/src/map/lapack2flamec/f2c/c/dtpmlqt.c +++ b/src/map/lapack2flamec/f2c/c/dtpmlqt.c @@ -220,7 +220,7 @@ int dtpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical notran; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -317,7 +317,7 @@ int dtpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DTPMLQT", &i__1); + xerbla_("DTPMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpmqrt.c b/src/map/lapack2flamec/f2c/c/dtpmqrt.c index 527260be7..4f08dbffc 100644 --- a/src/map/lapack2flamec/f2c/c/dtpmqrt.c +++ b/src/map/lapack2flamec/f2c/c/dtpmqrt.c @@ -221,7 +221,7 @@ int dtpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); logical notran; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -320,7 +320,7 @@ int dtpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DTPMQRT", &i__1); + xerbla_("DTPMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpqrt.c b/src/map/lapack2flamec/f2c/c/dtpqrt.c index ea83af544..19e283379 100644 --- a/src/map/lapack2flamec/f2c/c/dtpqrt.c +++ b/src/map/lapack2flamec/f2c/c/dtpqrt.c @@ -185,7 +185,7 @@ int dtpqrt_(integer *m, integer *n, integer *l, integer *nb, doublereal *a, inte /* Local variables */ integer i__, ib, lb, mb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpqrt2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dtprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dtpqrt2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -246,7 +246,7 @@ int dtpqrt_(integer *m, integer *n, integer *l, integer *nb, doublereal *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("DTPQRT", &i__1); + xerbla_("DTPQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpqrt2.c b/src/map/lapack2flamec/f2c/c/dtpqrt2.c index f6ae193b9..a1c7d5045 100644 --- a/src/map/lapack2flamec/f2c/c/dtpqrt2.c +++ b/src/map/lapack2flamec/f2c/c/dtpqrt2.c @@ -177,7 +177,7 @@ int dtpqrt2_(integer *m, integer *n, integer *l, doublereal * a, integer *lda, d int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); doublereal alpha; extern /* Subroutine */ - int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -236,7 +236,7 @@ int dtpqrt2_(integer *m, integer *n, integer *l, doublereal * a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DTPQRT2", &i__1); + xerbla_("DTPQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtprfs.c b/src/map/lapack2flamec/f2c/c/dtprfs.c index d903be1e2..ff73dedf4 100644 --- a/src/map/lapack2flamec/f2c/c/dtprfs.c +++ b/src/map/lapack2flamec/f2c/c/dtprfs.c @@ -192,7 +192,7 @@ int dtprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -268,7 +268,7 @@ int dtprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DTPRFS", &i__1); + xerbla_("DTPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtptri.c b/src/map/lapack2flamec/f2c/c/dtptri.c index 98bc96670..0bd58120d 100644 --- a/src/map/lapack2flamec/f2c/c/dtptri.c +++ b/src/map/lapack2flamec/f2c/c/dtptri.c @@ -124,7 +124,7 @@ int dtptri_(char *uplo, char *diag, integer *n, doublereal * ap, integer *info) int dtpmv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jclast; logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -152,6 +152,7 @@ int dtptri_(char *uplo, char *diag, integer *n, doublereal * ap, integer *info) *info = 0; upper = lsame_(uplo, "U"); nounit = lsame_(diag, "N"); + jclast = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -167,7 +168,7 @@ int dtptri_(char *uplo, char *diag, integer *n, doublereal * ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("DTPTRI", &i__1); + xerbla_("DTPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtptrs.c b/src/map/lapack2flamec/f2c/c/dtptrs.c index 5849898cd..e820f7ae3 100644 --- a/src/map/lapack2flamec/f2c/c/dtptrs.c +++ b/src/map/lapack2flamec/f2c/c/dtptrs.c @@ -132,7 +132,7 @@ int dtptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dtpsv_(char *, char *, char *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -191,7 +191,7 @@ int dtptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DTPTRS", &i__1); + xerbla_("DTPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtpttf.c b/src/map/lapack2flamec/f2c/c/dtpttf.c index ad75b0dc9..bfeac1076 100644 --- a/src/map/lapack2flamec/f2c/c/dtpttf.c +++ b/src/map/lapack2flamec/f2c/c/dtpttf.c @@ -182,12 +182,12 @@ int dtpttf_(char *transr, char *uplo, integer *n, doublereal *ap, doublereal *ar /* System generated locals */ integer i__1, i__2, i__3; /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -227,7 +227,7 @@ int dtpttf_(char *transr, char *uplo, integer *n, doublereal *ap, doublereal *ar if (*info != 0) { i__1 = -(*info); - xerbla_("DTPTTF", &i__1); + xerbla_("DTPTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -251,7 +251,6 @@ int dtpttf_(char *transr, char *uplo, integer *n, doublereal *ap, doublereal *ar return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/dtpttr.c b/src/map/lapack2flamec/f2c/c/dtpttr.c index bcedc624c..87e5afde1 100644 --- a/src/map/lapack2flamec/f2c/c/dtpttr.c +++ b/src/map/lapack2flamec/f2c/c/dtpttr.c @@ -102,7 +102,7 @@ int dtpttr_(char *uplo, integer *n, doublereal *ap, doublereal *a, integer *lda, extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -145,7 +145,7 @@ int dtpttr_(char *uplo, integer *n, doublereal *ap, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DTPTTR", &i__1); + xerbla_("DTPTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrcon.c b/src/map/lapack2flamec/f2c/c/dtrcon.c index 3dda2d7fb..9c52251d2 100644 --- a/src/map/lapack2flamec/f2c/c/dtrcon.c +++ b/src/map/lapack2flamec/f2c/c/dtrcon.c @@ -149,7 +149,7 @@ int dtrcon_(char *norm, char *uplo, char *diag, integer *n, doublereal *a, integ extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlantr_(char *, char *, char *, integer *, integer *, doublereal *, integer *, doublereal *); doublereal ainvnm; extern /* Subroutine */ @@ -215,7 +215,7 @@ int dtrcon_(char *norm, char *uplo, char *diag, integer *n, doublereal *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("DTRCON", &i__1); + xerbla_("DTRCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrevc.c b/src/map/lapack2flamec/f2c/c/dtrevc.c index 4981c5c2c..13d1afa0c 100644 --- a/src/map/lapack2flamec/f2c/c/dtrevc.c +++ b/src/map/lapack2flamec/f2c/c/dtrevc.c @@ -266,7 +266,7 @@ int dtrevc_(char *side, char *howmny, logical *select, integer *n, doublereal *t extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical rightv; doublereal smlnum; @@ -400,7 +400,7 @@ int dtrevc_(char *side, char *howmny, logical *select, integer *n, doublereal *t if (*info != 0) { i__1 = -(*info); - xerbla_("DTREVC", &i__1); + xerbla_("DTREVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrevc3.c b/src/map/lapack2flamec/f2c/c/dtrevc3.c index 8416f5d6c..cbf26fe44 100644 --- a/src/map/lapack2flamec/f2c/c/dtrevc3.c +++ b/src/map/lapack2flamec/f2c/c/dtrevc3.c @@ -246,8 +246,7 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal * AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("dtrevc3 inputs: side %c, howmny %c, n %" FLA_IS ", ldt %" FLA_IS ", ldvl %" FLA_IS ", ldvr %" FLA_IS ", mm %" FLA_IS ", lwork %" FLA_IS "",*side, *howmny, *n, *ldt, *ldvl, *ldvr, *mm, *lwork); /* System generated locals */ - address a__1[2]; - integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1[2], i__2, i__3, i__4; + integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__2, i__3, i__4; doublereal d__1, d__2, d__3, d__4; char ch__1[2]; /* Builtin functions */ @@ -292,7 +291,7 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal * extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); @@ -445,7 +444,7 @@ int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal * if (*info != 0) { i__2 = -(*info); - xerbla_("DTREVC3", &i__2); + xerbla_("DTREVC3", &i__2, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrexc.c b/src/map/lapack2flamec/f2c/c/dtrexc.c index 2cc429ad4..21dbba231 100644 --- a/src/map/lapack2flamec/f2c/c/dtrexc.c +++ b/src/map/lapack2flamec/f2c/c/dtrexc.c @@ -152,7 +152,7 @@ int dtrexc_(char *compq, integer *n, doublereal *t, integer * ldt, doublereal *q extern logical lsame_(char *, char *); logical wantq; extern /* Subroutine */ - int dlaexc_(logical *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlaexc_(logical *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer nbnext; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -213,7 +213,7 @@ int dtrexc_(char *compq, integer *n, doublereal *t, integer * ldt, doublereal *q if (*info != 0) { i__1 = -(*info); - xerbla_("DTREXC", &i__1); + xerbla_("DTREXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrrfs.c b/src/map/lapack2flamec/f2c/c/dtrrfs.c index c8d3a5605..394414026 100644 --- a/src/map/lapack2flamec/f2c/c/dtrrfs.c +++ b/src/map/lapack2flamec/f2c/c/dtrrfs.c @@ -196,7 +196,7 @@ int dtrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -278,7 +278,7 @@ int dtrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DTRRFS", &i__1); + xerbla_("DTRRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrsen.c b/src/map/lapack2flamec/f2c/c/dtrsen.c index 3def921d4..47f56cd0a 100644 --- a/src/map/lapack2flamec/f2c/c/dtrsen.c +++ b/src/map/lapack2flamec/f2c/c/dtrsen.c @@ -340,7 +340,7 @@ int dtrsen_(char *job, char *compq, logical *select, integer *n, doublereal *t, int dlacn2_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical wantbh; extern /* Subroutine */ int dtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); @@ -390,6 +390,8 @@ int dtrsen_(char *job, char *compq, logical *select, integer *n, doublereal *t, wantq = lsame_(compq, "V"); *info = 0; lquery = *lwork == -1; + liwmin = 0; + lwmin = 0; if (! lsame_(job, "N") && ! wants && ! wantsp) { *info = -1; @@ -493,7 +495,7 @@ int dtrsen_(char *job, char *compq, logical *select, integer *n, doublereal *t, if (*info != 0) { i__1 = -(*info); - xerbla_("DTRSEN", &i__1); + xerbla_("DTRSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrsna.c b/src/map/lapack2flamec/f2c/c/dtrsna.c index 918d377c7..07383306a 100644 --- a/src/map/lapack2flamec/f2c/c/dtrsna.c +++ b/src/map/lapack2flamec/f2c/c/dtrsna.c @@ -299,7 +299,7 @@ int dtrsna_(char *job, char *howmny, logical *select, integer *n, doublereal *t, int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical wantbh; extern /* Subroutine */ @@ -441,7 +441,7 @@ int dtrsna_(char *job, char *howmny, logical *select, integer *n, doublereal *t, if (*info != 0) { i__1 = -(*info); - xerbla_("DTRSNA", &i__1); + xerbla_("DTRSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrsyl.c b/src/map/lapack2flamec/f2c/c/dtrsyl.c index c5c933ade..28ec73c60 100644 --- a/src/map/lapack2flamec/f2c/c/dtrsyl.c +++ b/src/map/lapack2flamec/f2c/c/dtrsyl.c @@ -187,7 +187,7 @@ int dtrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dou extern doublereal dlamch_(char *), dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); doublereal scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical notrna, notrnb; doublereal smlnum; @@ -263,7 +263,7 @@ int dtrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dou if (*info != 0) { i__1 = -(*info); - xerbla_("DTRSYL", &i__1); + xerbla_("DTRSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrsyl3.c b/src/map/lapack2flamec/f2c/c/dtrsyl3.c index 034158036..d476627fa 100644 --- a/src/map/lapack2flamec/f2c/c/dtrsyl3.c +++ b/src/map/lapack2flamec/f2c/c/dtrsyl3.c @@ -191,11 +191,10 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do /* Builtin functions */ double pow_dd(doublereal *, doublereal *); /* Local variables */ - extern /* Subroutine */ - int f90_cycle_(void); integer i__, j, k, l, i1, i2, j1, j2, k1, k2, l1, l2, nb, pc, jj, ll, nba, nbb; doublereal buf, sgn, scal, anrm, bnrm, cnrm; - integer awrk, bwrk, temp; + integer awrk, bwrk; + int temp; logical skip; doublereal *wnrm, xnrm; extern /* Subroutine */ @@ -208,7 +207,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do doublereal scaloc, scamin; extern doublereal dlarmm_(doublereal *, doublereal *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublereal bignum; logical notrna, notrnb; @@ -312,7 +311,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("DTRSYL3", &i__1); + xerbla_("DTRSYL3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -564,7 +563,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; buf *= pow_dd(&c_b19, &d__1); } i__2 = nbb; @@ -582,7 +581,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -616,7 +615,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -629,16 +628,16 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } @@ -702,7 +701,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -715,15 +714,15 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -814,7 +813,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } @@ -833,7 +832,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -868,7 +867,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__4 = nbb; for (jj = 1; @@ -881,16 +880,16 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -953,7 +952,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__4 = nbb; for (jj = 1; @@ -966,15 +965,15 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1065,7 +1064,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__2 = nbb; @@ -1083,7 +1082,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -1117,7 +1116,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -1130,17 +1129,17 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1203,7 +1202,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -1216,17 +1215,17 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1315,7 +1314,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__1 = nbb; @@ -1333,7 +1332,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -1368,7 +1367,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -1381,15 +1380,15 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1452,7 +1451,7 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -1465,17 +1464,17 @@ int dtrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; diff --git a/src/map/lapack2flamec/f2c/c/dtrtrs.c b/src/map/lapack2flamec/f2c/c/dtrtrs.c index 277fe3e03..754eb04c9 100644 --- a/src/map/lapack2flamec/f2c/c/dtrtrs.c +++ b/src/map/lapack2flamec/f2c/c/dtrtrs.c @@ -138,7 +138,7 @@ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_( char *, integer *); + int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -202,7 +202,7 @@ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DTRTRS", &i__1); + xerbla_("DTRTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrttf.c b/src/map/lapack2flamec/f2c/c/dtrttf.c index c52fd9a61..4a21e7caa 100644 --- a/src/map/lapack2flamec/f2c/c/dtrttf.c +++ b/src/map/lapack2flamec/f2c/c/dtrttf.c @@ -193,7 +193,7 @@ int dtrttf_(char *transr, char *uplo, integer *n, doublereal *a, integer *lda, d extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -242,7 +242,7 @@ int dtrttf_(char *transr, char *uplo, integer *n, doublereal *a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("DTRTTF", &i__1); + xerbla_("DTRTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtrttp.c b/src/map/lapack2flamec/f2c/c/dtrttp.c index d6a254c99..ab6fb8245 100644 --- a/src/map/lapack2flamec/f2c/c/dtrttp.c +++ b/src/map/lapack2flamec/f2c/c/dtrttp.c @@ -102,7 +102,7 @@ int dtrttp_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *ap extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -145,7 +145,7 @@ int dtrttp_(char *uplo, integer *n, doublereal *a, integer * lda, doublereal *ap if (*info != 0) { i__1 = -(*info); - xerbla_("DTRTTP", &i__1); + xerbla_("DTRTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/dtzrqf.c b/src/map/lapack2flamec/f2c/c/dtzrqf.c index 25d6b41ce..0cd1cc18d 100644 --- a/src/map/lapack2flamec/f2c/c/dtzrqf.c +++ b/src/map/lapack2flamec/f2c/c/dtzrqf.c @@ -135,7 +135,7 @@ int dtzrqf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta /* Local variables */ integer i__, k, m1; extern /* Subroutine */ - int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *, doublereal *, integer *), daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfg_( integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -177,7 +177,7 @@ int dtzrqf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DTZRQF", &i__1); + xerbla_("DTZRQF", &i__1, (ftnlen)6); return 0; } /* Perform the factorization. */ diff --git a/src/map/lapack2flamec/f2c/c/dtzrzf.c b/src/map/lapack2flamec/f2c/c/dtzrzf.c index 14885019d..45cf6c930 100644 --- a/src/map/lapack2flamec/f2c/c/dtzrzf.c +++ b/src/map/lapack2flamec/f2c/c/dtzrzf.c @@ -149,7 +149,7 @@ int dtzrzf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta /* Local variables */ integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin; extern /* Subroutine */ - int xerbla_(char *, integer *), dlarzb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlarzb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlarzt_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); @@ -188,6 +188,7 @@ int dtzrzf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta /* Function Body */ *info = 0; lquery = *lwork == -1; + nb = 0; if (*m < 0) { *info = -1; @@ -223,7 +224,7 @@ int dtzrzf_(integer *m, integer *n, doublereal *a, integer * lda, doublereal *ta if (*info != 0) { i__1 = -(*info); - xerbla_("DTZRZF", &i__1); + xerbla_("DTZRZF", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/iparam2stage.c b/src/map/lapack2flamec/f2c/c/iparam2stage.c index 6055b6baf..b0bea7666 100644 --- a/src/map/lapack2flamec/f2c/c/iparam2stage.c +++ b/src/map/lapack2flamec/f2c/c/iparam2stage.c @@ -1,6 +1,9 @@ /* ../netlib/v3.9.0/iparam2stage.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#ifdef FLA_OPENMP_MULTITHREADING +#include +#endif static integer c__1 = 1; static integer c_n1 = -1; /* > \brief \b IPARAM2STAGE */ @@ -160,9 +163,7 @@ integer iparam2stage_(integer *ispec, char *name__, char *opts, integer *ni, int char subnam[12]; integer lqoptnb, qroptnb; ftnlen name_len = strlen(name__); - /* #if defined(_OPENMP) */ - /* use omp_lib */ - /* #endif */ + int fla_thread_get_num_threads(void); /* -- LAPACK auxiliary routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,11 +186,10 @@ integer iparam2stage_(integer *ispec, char *name__, char *opts, integer *ni, int } /* Get the number of threads */ nthreads = 1; - /* #if defined(_OPENMP) */ - /* !$OMP PARALLEL */ - /* NTHREADS = OMP_GET_NUM_THREADS() */ - /* !$OMP END PARALLEL */ - /* #endif */ +#ifdef FLA_OPENMP_MULTITHREADING +#pragma omp parallel + nthreads = fla_thread_get_num_threads(); +#endif /* WRITE(*,*) 'IPARAM VOICI NTHREADS ISPEC ',NTHREADS, ISPEC */ if (*ispec != 19) { diff --git a/src/map/lapack2flamec/f2c/c/postprocess.sh b/src/map/lapack2flamec/f2c/c/postprocess.sh index dd8f34b85..2db6a394d 100755 --- a/src/map/lapack2flamec/f2c/c/postprocess.sh +++ b/src/map/lapack2flamec/f2c/c/postprocess.sh @@ -22,7 +22,10 @@ main() 'dotu_(' 'dotu_f2c_(' \ ' abs(' ' f2c_abs(' \ '__(' '_(' \ - 'ladiv_(' 'ladiv_f2c_(' \ + 'cladiv_(' 'cladiv_f2c_(' \ + 'zladiv_(' 'zladiv_f2c_(' \ + ' max(' ' fla_max('\ + ' min(' ' fla_min('\ ) # '\\#include \"blaswrap.h\"' ' ' \ diff --git a/src/map/lapack2flamec/f2c/c/sbbcsd.c b/src/map/lapack2flamec/f2c/c/sbbcsd.c index 7cf015a91..7ddd3f153 100644 --- a/src/map/lapack2flamec/f2c/c/sbbcsd.c +++ b/src/map/lapack2flamec/f2c/c/sbbcsd.c @@ -367,7 +367,7 @@ int sbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, real sigma11, sigma21; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real thresh, tolmul; logical lquery; real b11bulge, b12bulge; @@ -488,7 +488,7 @@ int sbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("SBBCSD", &i__1); + xerbla_("SBBCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sbdsdc.c b/src/map/lapack2flamec/f2c/c/sbdsdc.c index d4a33f846..380a3a9d0 100644 --- a/src/map/lapack2flamec/f2c/c/sbdsdc.c +++ b/src/map/lapack2flamec/f2c/c/sbdsdc.c @@ -224,7 +224,7 @@ int sbdsdc_(char *uplo, char *compq, integer *n, real *d__, real *e, real *u, in int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), slasd0_(integer *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -278,6 +278,15 @@ int sbdsdc_(char *uplo, char *compq, integer *n, real *d__, real *e, real *u, in /* Function Body */ *info = 0; iuplo = 0; + givnum = 0; + givcol = 0; + poles = 0; + difr = 0; + difl = 0; + ivt = 0; + is = 0; + ic = 0; + z__ = 0; if (lsame_(uplo, "U")) { iuplo = 1; @@ -325,7 +334,7 @@ int sbdsdc_(char *uplo, char *compq, integer *n, real *d__, real *e, real *u, in if (*info != 0) { i__1 = -(*info); - xerbla_("SBDSDC", &i__1); + xerbla_("SBDSDC", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sbdsqr.c b/src/map/lapack2flamec/f2c/c/sbdsqr.c index 23d066810..58484a12e 100644 --- a/src/map/lapack2flamec/f2c/c/sbdsqr.c +++ b/src/map/lapack2flamec/f2c/c/sbdsqr.c @@ -281,7 +281,7 @@ int sbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, int sswap_(integer *, real *, integer *, real *, integer *), slasq1_(integer *, real *, real *, real *, integer *), slasv2_(real *, real *, real *, real *, real *, real *, real *, real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real sminoa; extern /* Subroutine */ int slartg_(real *, real *, real *, real *, real * ); @@ -360,7 +360,7 @@ int sbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, if (*info != 0) { i__1 = -(*info); - xerbla_("SBDSQR", &i__1); + xerbla_("SBDSQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sbdsvdx.c b/src/map/lapack2flamec/f2c/c/sbdsvdx.c index 014d51515..2a1f1fc2a 100644 --- a/src/map/lapack2flamec/f2c/c/sbdsvdx.c +++ b/src/map/lapack2flamec/f2c/c/sbdsvdx.c @@ -280,7 +280,7 @@ int sbdsvdx_(char *uplo, char *jobz, char *range, integer *n, real *d__, real *e integer irowz, iifail; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real abstol; extern /* Subroutine */ @@ -377,7 +377,7 @@ int sbdsvdx_(char *uplo, char *jobz, char *range, integer *n, real *d__, real *e if (*info != 0) { i__1 = -(*info); - xerbla_("SBDSVDX", &i__1); + xerbla_("SBDSVDX", &i__1, (ftnlen)7); return 0; } /* Quick return if possible (N.LE.1) */ diff --git a/src/map/lapack2flamec/f2c/c/sdisna.c b/src/map/lapack2flamec/f2c/c/sdisna.c index 518bb4303..bc35af8ae 100644 --- a/src/map/lapack2flamec/f2c/c/sdisna.c +++ b/src/map/lapack2flamec/f2c/c/sdisna.c @@ -121,7 +121,7 @@ int sdisna_(char *job, integer *m, integer *n, real *d__, real *sep, integer *in extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real newgap, thresh; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -211,7 +211,7 @@ int sdisna_(char *job, integer *m, integer *n, real *d__, real *sep, integer *in if (*info != 0) { i__1 = -(*info); - xerbla_("SDISNA", &i__1); + xerbla_("SDISNA", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgbbrd.c b/src/map/lapack2flamec/f2c/c/sgbbrd.c index a5adc255a..eebed927c 100644 --- a/src/map/lapack2flamec/f2c/c/sgbbrd.c +++ b/src/map/lapack2flamec/f2c/c/sgbbrd.c @@ -199,7 +199,7 @@ int sgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ integer minmn; logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slargv_( integer *, real *, integer *, real *, integer *, real *, integer * ), slartv_(integer *, real *, integer *, real *, integer *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slargv_( integer *, real *, integer *, real *, integer *, real *, integer * ), slartv_(integer *, real *, integer *, real *, integer *, real *, real *, integer *); logical wantpt; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -288,7 +288,7 @@ int sgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGBBRD", &i__1); + xerbla_("SGBBRD", &i__1, (ftnlen)6); return 0; } /* Initialize Q and P**T to the unit matrix, if needed */ diff --git a/src/map/lapack2flamec/f2c/c/sgbcon.c b/src/map/lapack2flamec/f2c/c/sgbcon.c index 22a83cd7e..0812149ff 100644 --- a/src/map/lapack2flamec/f2c/c/sgbcon.c +++ b/src/map/lapack2flamec/f2c/c/sgbcon.c @@ -160,7 +160,7 @@ int sgbcon_(char *norm, integer *n, integer *kl, integer *ku, real *ab, integer int srscl_(integer *, real *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; extern /* Subroutine */ @@ -228,7 +228,7 @@ int sgbcon_(char *norm, integer *n, integer *kl, integer *ku, real *ab, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGBCON", &i__1); + xerbla_("SGBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgbequ.c b/src/map/lapack2flamec/f2c/c/sgbequ.c index 96a183afc..bd6c9102b 100644 --- a/src/map/lapack2flamec/f2c/c/sgbequ.c +++ b/src/map/lapack2flamec/f2c/c/sgbequ.c @@ -154,7 +154,7 @@ int sgbequ_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer real rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -208,7 +208,7 @@ int sgbequ_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGBEQU", &i__1); + xerbla_("SGBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgbequb.c b/src/map/lapack2flamec/f2c/c/sgbequb.c index c058f6b2d..2f5e89ce2 100644 --- a/src/map/lapack2flamec/f2c/c/sgbequb.c +++ b/src/map/lapack2flamec/f2c/c/sgbequb.c @@ -157,7 +157,7 @@ int sgbequb_(integer *m, integer *n, integer *kl, integer * ku, real *ab, intege real radix, rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -211,7 +211,7 @@ int sgbequb_(integer *m, integer *n, integer *kl, integer * ku, real *ab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGBEQUB", &i__1); + xerbla_("SGBEQUB", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sgbrfs.c b/src/map/lapack2flamec/f2c/c/sgbrfs.c index dfe23d735..c0b339217 100644 --- a/src/map/lapack2flamec/f2c/c/sgbrfs.c +++ b/src/map/lapack2flamec/f2c/c/sgbrfs.c @@ -223,7 +223,7 @@ int sgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, r extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -312,7 +312,7 @@ int sgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, r if (*info != 0) { i__1 = -(*info); - xerbla_("SGBRFS", &i__1); + xerbla_("SGBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgbrfsx.c b/src/map/lapack2flamec/f2c/c/sgbrfsx.c index 1815a089a..e452877bb 100644 --- a/src/map/lapack2flamec/f2c/c/sgbrfsx.c +++ b/src/map/lapack2flamec/f2c/c/sgbrfsx.c @@ -461,7 +461,7 @@ int sgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in real anorm; extern real slangb_(char *, integer *, integer *, integer *, real *, integer *, real *), slamch_(char *); extern /* Subroutine */ - int sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -622,7 +622,7 @@ int sgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in if (*info != 0) { i__1 = -(*info); - xerbla_("SGBRFSX", &i__1); + xerbla_("SGBRFSX", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sgbsv.c b/src/map/lapack2flamec/f2c/c/sgbsv.c index d92545759..367cc0b68 100644 --- a/src/map/lapack2flamec/f2c/c/sgbsv.c +++ b/src/map/lapack2flamec/f2c/c/sgbsv.c @@ -163,7 +163,7 @@ int sgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, real *ab, integ integer ab_dim1, ab_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), sgbtrf_( integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgbtrf_( integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -216,7 +216,7 @@ int sgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, real *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGBSV ", &i__1); + xerbla_("SGBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgbsvx.c b/src/map/lapack2flamec/f2c/c/sgbsvx.c index a15bba51b..29fe676e1 100644 --- a/src/map/lapack2flamec/f2c/c/sgbsvx.c +++ b/src/map/lapack2flamec/f2c/c/sgbsvx.c @@ -387,7 +387,7 @@ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ int slaqgb_(integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *); logical nofact; extern /* Subroutine */ - int sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgbcon_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slantb_(char *, char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -451,6 +451,8 @@ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -582,7 +584,7 @@ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGBSVX", &i__1); + xerbla_("SGBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgbsvxx.c b/src/map/lapack2flamec/f2c/c/sgbsvxx.c index 48628ea6b..67067f22f 100644 --- a/src/map/lapack2flamec/f2c/c/sgbsvxx.c +++ b/src/map/lapack2flamec/f2c/c/sgbsvxx.c @@ -577,7 +577,7 @@ int sgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int int slaqgb_(integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; logical colequ; @@ -777,7 +777,7 @@ int sgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int if (*info != 0) { i__1 = -(*info); - xerbla_("SGBSVXX", &i__1); + xerbla_("SGBSVXX", &i__1, (ftnlen)7); return 0; } if (equil) diff --git a/src/map/lapack2flamec/f2c/c/sgbtf2.c b/src/map/lapack2flamec/f2c/c/sgbtf2.c index 9d818dca2..7bff0de33 100644 --- a/src/map/lapack2flamec/f2c/c/sgbtf2.c +++ b/src/map/lapack2flamec/f2c/c/sgbtf2.c @@ -151,7 +151,7 @@ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer /* Local variables */ integer i__, j, km, jp, ju, kv; extern /* Subroutine */ - int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *), sscal_(integer *, real *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *), sscal_(integer *, real *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -210,7 +210,7 @@ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGBTF2", &i__1); + xerbla_("SGBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -221,7 +221,7 @@ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -254,13 +254,13 @@ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer ++j) { #if AOCL_FLA_PROGRESS_H - if(aocl_fla_progress_ptr){ - if(j%32==0 || j==i__1){ - step_count=j; - AOCL_FLA_PROGRESS_FUNC_PTR("SGBTF2",6,&step_count,&thread_id,&total_threads); - } - } - #endif + if(aocl_fla_progress_ptr){ + if(j%32==0 || j==i__1){ + progress_step_count=j; + AOCL_FLA_PROGRESS_FUNC_PTR("SGBTF2",6,&progress_step_count,&progress_thread_id,&progress_total_threads); + } + } + #endif /* Set fill-in elements in column J+KV to zero. */ if (j + kv <= *n) diff --git a/src/map/lapack2flamec/f2c/c/sgbtrf.c b/src/map/lapack2flamec/f2c/c/sgbtrf.c index 419590195..a6eb75ff8 100644 --- a/src/map/lapack2flamec/f2c/c/sgbtrf.c +++ b/src/map/lapack2flamec/f2c/c/sgbtrf.c @@ -160,7 +160,7 @@ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer , work31[4160] /* was [65][ 64] */ ; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), sgbtf2_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), sgbtf2_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *), isamax_(integer *, real *, integer *); extern /* Subroutine */ int slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); @@ -224,7 +224,7 @@ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGBTRF", &i__1); + xerbla_("SGBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -235,7 +235,7 @@ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -319,8 +319,8 @@ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku, real *ab, integer jb = fla_min(i__3,i__4); #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("SGBTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("SGBTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/map/lapack2flamec/f2c/c/sgbtrs.c b/src/map/lapack2flamec/f2c/c/sgbtrs.c index 26af824a8..a10852235 100644 --- a/src/map/lapack2flamec/f2c/c/sgbtrs.c +++ b/src/map/lapack2flamec/f2c/c/sgbtrs.c @@ -147,7 +147,7 @@ int sgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, r int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical lnoti; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -212,7 +212,7 @@ int sgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, r if (*info != 0) { i__1 = -(*info); - xerbla_("SGBTRS", &i__1); + xerbla_("SGBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgebak.c b/src/map/lapack2flamec/f2c/c/sgebak.c index 79c85602e..b68e3391c 100644 --- a/src/map/lapack2flamec/f2c/c/sgebak.c +++ b/src/map/lapack2flamec/f2c/c/sgebak.c @@ -134,7 +134,7 @@ int sgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real int sscal_(integer *, real *, real *, integer *); logical leftv; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -196,7 +196,7 @@ int sgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGEBAK", &i__1); + xerbla_("SGEBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgebal.c b/src/map/lapack2flamec/f2c/c/sgebal.c index 6cfd412c2..fe9e91daa 100644 --- a/src/map/lapack2flamec/f2c/c/sgebal.c +++ b/src/map/lapack2flamec/f2c/c/sgebal.c @@ -169,7 +169,7 @@ int sgebal_(char *job, integer *n, real *a, integer *lda, integer *ilo, integer real sfmin1, sfmin2, sfmax1, sfmax2; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern logical sisnan_(real *); logical noconv; @@ -216,7 +216,7 @@ int sgebal_(char *job, integer *n, real *a, integer *lda, integer *ilo, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGEBAL", &i__1); + xerbla_("SGEBAL", &i__1, (ftnlen)6); return 0; } k = 1; @@ -400,7 +400,7 @@ int sgebal_(char *job, integer *n, real *a, integer *lda, integer *ilo, integer /* Exit if NaN to avoid infinite loop */ *info = -3; i__2 = -(*info); - xerbla_("SGEBAL", &i__2); + xerbla_("SGEBAL", &i__2, (ftnlen)6); return 0; } f /= 2.f; diff --git a/src/map/lapack2flamec/f2c/c/sgecon.c b/src/map/lapack2flamec/f2c/c/sgecon.c index bfaf84951..16d634981 100644 --- a/src/map/lapack2flamec/f2c/c/sgecon.c +++ b/src/map/lapack2flamec/f2c/c/sgecon.c @@ -135,7 +135,7 @@ int sgecon_(char *norm, integer *n, real *a, integer *lda, real *anorm, real *rc int srscl_(integer *, real *, real *, integer *), slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; logical onenrm; @@ -194,7 +194,7 @@ int sgecon_(char *norm, integer *n, real *a, integer *lda, real *anorm, real *rc if (*info != 0) { i__1 = -(*info); - xerbla_("SGECON", &i__1); + xerbla_("SGECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgeequ.c b/src/map/lapack2flamec/f2c/c/sgeequ.c index 3d900f786..e2f139bbd 100644 --- a/src/map/lapack2flamec/f2c/c/sgeequ.c +++ b/src/map/lapack2flamec/f2c/c/sgeequ.c @@ -140,7 +140,7 @@ int sgeequ_(integer *m, integer *n, real *a, integer *lda, real *r__, real *c__, real rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -186,7 +186,7 @@ int sgeequ_(integer *m, integer *n, real *a, integer *lda, real *r__, real *c__, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEEQU", &i__1); + xerbla_("SGEEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgeequb.c b/src/map/lapack2flamec/f2c/c/sgeequb.c index 874edde1b..64a4f1261 100644 --- a/src/map/lapack2flamec/f2c/c/sgeequb.c +++ b/src/map/lapack2flamec/f2c/c/sgeequb.c @@ -143,7 +143,7 @@ int sgeequb_(integer *m, integer *n, real *a, integer *lda, real *r__, real *c__ real radix, rcmin, rcmax; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -189,7 +189,7 @@ int sgeequb_(integer *m, integer *n, real *a, integer *lda, real *r__, real *c__ if (*info != 0) { i__1 = -(*info); - xerbla_("SGEEQUB", &i__1); + xerbla_("SGEEQUB", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sgees.c b/src/map/lapack2flamec/f2c/c/sgees.c index 98487f61f..c643dcbc6 100644 --- a/src/map/lapack2flamec/f2c/c/sgees.c +++ b/src/map/lapack2flamec/f2c/c/sgees.c @@ -213,7 +213,7 @@ if */ /* > \ingroup realGEeigen */ /* ===================================================================== */ /* Subroutine */ -int sgees_(char *jobvs, char *sort, L_fp select, integer *n, real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs, integer *ldvs, real *work, integer *lwork, logical *bwork, integer * info) +int sgees_(char *jobvs, char *sort, L_fps2 select, integer *n, real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs, integer *ldvs, real *work, integer *lwork, logical *bwork, integer * info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgees inputs: jobvs %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", sdim %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *n, *lda, *sdim, *ldvs); @@ -242,7 +242,7 @@ int sgees_(char *jobvs, char *sort, L_fp select, integer *n, real *a, integer *l int sgebak_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), sgebal_(char *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -366,7 +366,7 @@ int sgees_(char *jobvs, char *sort, L_fp select, integer *n, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SGEES ", &i__1); + xerbla_("SGEES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgeesx.c b/src/map/lapack2flamec/f2c/c/sgeesx.c index c1fd5f02f..b0c237e6a 100644 --- a/src/map/lapack2flamec/f2c/c/sgeesx.c +++ b/src/map/lapack2flamec/f2c/c/sgeesx.c @@ -283,7 +283,7 @@ if */ /* > \ingroup realGEeigen */ /* ===================================================================== */ /* Subroutine */ -int sgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs, integer *ldvs, real *rconde, real *rcondv, real * work, integer *lwork, integer *iwork, integer *liwork, logical *bwork, integer *info) +int sgeesx_(char *jobvs, char *sort, L_fps2 select, char * sense, integer *n, real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs, integer *ldvs, real *rconde, real *rcondv, real * work, integer *lwork, integer *iwork, integer *liwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgeesx inputs: jobvs %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", sdim %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *sense, *n, *lda, *sdim, *ldvs); @@ -311,7 +311,7 @@ int sgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, real int sgebak_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), sgebal_(char *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -371,6 +371,7 @@ int sgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, real wantsv = lsame_(sense, "V"); wantsb = lsame_(sense, "B"); lquery = *lwork == -1 || *liwork == -1; + maxwrk = 0; if (! wantvs && ! lsame_(jobvs, "N")) { *info = -1; @@ -467,7 +468,7 @@ int sgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGEESX", &i__1); + xerbla_("SGEESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgeev.c b/src/map/lapack2flamec/f2c/c/sgeev.c index 306abf247..409d32218 100644 --- a/src/map/lapack2flamec/f2c/c/sgeev.c +++ b/src/map/lapack2flamec/f2c/c/sgeev.c @@ -218,7 +218,7 @@ int sgeev_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *wr int sgebak_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), sgebal_(char *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; real bignum; @@ -390,7 +390,7 @@ int sgeev_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *wr if (*info != 0) { i__1 = -(*info); - xerbla_("SGEEV ", &i__1); + xerbla_("SGEEV ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgeevx.c b/src/map/lapack2flamec/f2c/c/sgeevx.c index 35b462cce..07bbcd4c5 100644 --- a/src/map/lapack2flamec/f2c/c/sgeevx.c +++ b/src/map/lapack2flamec/f2c/c/sgeevx.c @@ -335,7 +335,7 @@ int sgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, re int sgebak_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), sgebal_(char *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; real bignum; @@ -543,7 +543,7 @@ int sgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, re if (*info != 0) { i__1 = -(*info); - xerbla_("SGEEVX", &i__1); + xerbla_("SGEEVX", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgegs.c b/src/map/lapack2flamec/f2c/c/sgegs.c index 47cc43e21..6994488c8 100644 --- a/src/map/lapack2flamec/f2c/c/sgegs.c +++ b/src/map/lapack2flamec/f2c/c/sgegs.c @@ -240,7 +240,7 @@ int sgegs_(char *jobvsl, char *jobvsr, integer *n, real *a, integer *lda, real * extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); real safmin; extern /* Subroutine */ - int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -386,7 +386,7 @@ int sgegs_(char *jobvsl, char *jobvsr, integer *n, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SGEGS ", &i__1); + xerbla_("SGEGS ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgegv.c b/src/map/lapack2flamec/f2c/c/sgegv.c index 727e3cdd2..b7a7c4fe0 100644 --- a/src/map/lapack2flamec/f2c/c/sgegv.c +++ b/src/map/lapack2flamec/f2c/c/sgegv.c @@ -330,7 +330,7 @@ int sgegv_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b, char chtemp[1]; logical ldumma[1]; extern /* Subroutine */ - int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ijobvl, iright; logical ilimit; @@ -476,7 +476,7 @@ int sgegv_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEGV ", &i__1); + xerbla_("SGEGV ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgehd2.c b/src/map/lapack2flamec/f2c/c/sgehd2.c index 3eaf91752..3c1c2a5f8 100644 --- a/src/map/lapack2flamec/f2c/c/sgehd2.c +++ b/src/map/lapack2flamec/f2c/c/sgehd2.c @@ -147,7 +147,7 @@ int sgehd2_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real integer i__; real aii; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -194,7 +194,7 @@ int sgehd2_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGEHD2", &i__1); + xerbla_("SGEHD2", &i__1, (ftnlen)6); return 0; } i__1 = *ihi - 1; diff --git a/src/map/lapack2flamec/f2c/c/sgehrd.c b/src/map/lapack2flamec/f2c/c/sgehrd.c index e331440c1..942e55ca2 100644 --- a/src/map/lapack2flamec/f2c/c/sgehrd.c +++ b/src/map/lapack2flamec/f2c/c/sgehrd.c @@ -174,7 +174,7 @@ int sgehrd_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real real ei; integer nb, nh, nx, iwt, nbmin, iinfo; extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), sgehd2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), slahr2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), sgehd2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), slahr2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -207,6 +207,7 @@ int sgehrd_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real --work; /* Function Body */ *info = 0; + nx = 0; lquery = *lwork == -1; if (*n < 0) { @@ -241,7 +242,7 @@ int sgehrd_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGEHRD", &i__1); + xerbla_("SGEHRD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgejsv.c b/src/map/lapack2flamec/f2c/c/sgejsv.c index 711dc867d..5db549912 100644 --- a/src/map/lapack2flamec/f2c/c/sgejsv.c +++ b/src/map/lapack2flamec/f2c/c/sgejsv.c @@ -511,7 +511,7 @@ int sgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo extern real slamch_(char *); real aatmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noscal; extern /* Subroutine */ int sgelqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *); @@ -660,7 +660,7 @@ int sgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { /* #:( */ i__1 = -(*info); - xerbla_("SGEJSV", &i__1); + xerbla_("SGEJSV", &i__1, (ftnlen)6); return 0; } /* Quick return for void matrix (Y3K safe) */ @@ -718,7 +718,7 @@ int sgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { *info = -9; i__2 = -(*info); - xerbla_("SGEJSV", &i__2); + xerbla_("SGEJSV", &i__2, (ftnlen)6); return 0; } aaqq = sqrt(aaqq); diff --git a/src/map/lapack2flamec/f2c/c/sgelq.c b/src/map/lapack2flamec/f2c/c/sgelq.c index a141b8d3b..b6b001a91 100644 --- a/src/map/lapack2flamec/f2c/c/sgelq.c +++ b/src/map/lapack2flamec/f2c/c/sgelq.c @@ -178,7 +178,7 @@ int sgelq_(integer *m, integer *n, real *a, integer *lda, real *t, integer *tsiz logical mint, minw; integer lwmin, lwreq, lwopt, nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgelqt_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -366,7 +366,7 @@ int sgelq_(integer *m, integer *n, real *a, integer *lda, real *t, integer *tsiz if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQ", &i__1); + xerbla_("SGELQ", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgelqt.c b/src/map/lapack2flamec/f2c/c/sgelqt.c index 1b0af8aa0..be68e8578 100644 --- a/src/map/lapack2flamec/f2c/c/sgelqt.c +++ b/src/map/lapack2flamec/f2c/c/sgelqt.c @@ -121,7 +121,7 @@ int sgelqt_(integer *m, integer *n, integer *mb, real *a, integer *lda, real *t, /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *), sgelqt3_( integer *, integer *, real *, integer *, real *, integer *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgelqt3_( integer *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -171,7 +171,7 @@ int sgelqt_(integer *m, integer *n, integer *mb, real *a, integer *lda, real *t, if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQT", &i__1); + xerbla_("SGELQT", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgelqt3.c b/src/map/lapack2flamec/f2c/c/sgelqt3.c index 056e4b510..793cf6d85 100644 --- a/src/map/lapack2flamec/f2c/c/sgelqt3.c +++ b/src/map/lapack2flamec/f2c/c/sgelqt3.c @@ -117,7 +117,7 @@ int sgelqt3_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld /* Local variables */ integer i__, j, i1, j1, m1, m2, iinfo; extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -162,7 +162,7 @@ int sgelqt3_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SGELQT3", &i__1); + xerbla_("SGELQT3", &i__1, (ftnlen)7); return 0; } if (*m == 1) diff --git a/src/map/lapack2flamec/f2c/c/sgels.c b/src/map/lapack2flamec/f2c/c/sgels.c index de5f45378..0ebf428f1 100644 --- a/src/map/lapack2flamec/f2c/c/sgels.c +++ b/src/map/lapack2flamec/f2c/c/sgels.c @@ -201,7 +201,7 @@ int sgels_(char *trans, integer *m, integer *n, integer * nrhs, real *a, integer int slabad_(real *, real *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; real bignum; @@ -340,7 +340,7 @@ int sgels_(char *trans, integer *m, integer *n, integer * nrhs, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGELS ", &i__1); + xerbla_("SGELS ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgelss.c b/src/map/lapack2flamec/f2c/c/sgelss.c index 6abbef2ab..9260572ab 100644 --- a/src/map/lapack2flamec/f2c/c/sgelss.c +++ b/src/map/lapack2flamec/f2c/c/sgelss.c @@ -194,7 +194,7 @@ int sgelss_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * int sgebrd_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -245,6 +245,7 @@ int sgelss_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * minmn = fla_min(*m,*n); maxmn = fla_max(*m,*n); lquery = *lwork == -1; + mnthr = 0; if (*m < 0) { *info = -1; @@ -445,7 +446,7 @@ int sgelss_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SGELSS", &i__1); + xerbla_("SGELSS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgelst.c b/src/map/lapack2flamec/f2c/c/sgelst.c index ffaeb25f5..aa55e5722 100644 --- a/src/map/lapack2flamec/f2c/c/sgelst.c +++ b/src/map/lapack2flamec/f2c/c/sgelst.c @@ -214,7 +214,7 @@ int sgelst_(char *trans, integer *m, integer *n, integer * nrhs, real *a, intege int slabad_(real *, real *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; real bignum; @@ -319,7 +319,7 @@ int sgelst_(char *trans, integer *m, integer *n, integer * nrhs, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGELST ", &i__1); + xerbla_("SGELST ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgelsx.c b/src/map/lapack2flamec/f2c/c/sgelsx.c index 1255599c2..6bf4a1b32 100644 --- a/src/map/lapack2flamec/f2c/c/sgelsx.c +++ b/src/map/lapack2flamec/f2c/c/sgelsx.c @@ -186,7 +186,7 @@ int sgelsx_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), slaic1_(integer *, integer *, real *, real *, real *, real *, real *, real *, real *), sorm2r_( char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slabad_(real *, real *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), sgeqpf_(integer *, integer *, real *, integer *, integer *, real *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -256,7 +256,7 @@ int sgelsx_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SGELSX", &i__1); + xerbla_("SGELSX", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgelsy.c b/src/map/lapack2flamec/f2c/c/sgelsy.c index 571043d5c..a3fe98de6 100644 --- a/src/map/lapack2flamec/f2c/c/sgelsy.c +++ b/src/map/lapack2flamec/f2c/c/sgelsy.c @@ -216,7 +216,7 @@ int sgelsy_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), slaic1_(integer *, integer *, real *, real *, real *, real *, real *, real *, real *), sgeqp3_( integer *, integer *, real *, integer *, integer *, real *, real *, integer *, integer *), slabad_(real *, real *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -326,7 +326,7 @@ int sgelsy_(integer *m, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SGELSY", &i__1); + xerbla_("SGELSY", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgemlq.c b/src/map/lapack2flamec/f2c/c/sgemlq.c index 473c037b2..a528b312f 100644 --- a/src/map/lapack2flamec/f2c/c/sgemlq.c +++ b/src/map/lapack2flamec/f2c/c/sgemlq.c @@ -172,9 +172,8 @@ int sgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int sgemlqt_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -225,21 +224,6 @@ int sgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a lw = *m * mb; mn = *n; } - if (nb > *k && mn > *k) - { - if ((mn - *k) % (nb - *k) == 0) - { - nblcks = (mn - *k) / (nb - *k); - } - else - { - nblcks = (mn - *k) / (nb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -284,7 +268,7 @@ int sgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SGEMLQ", &i__1); + xerbla_("SGEMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgemlqt.c b/src/map/lapack2flamec/f2c/c/sgemlqt.c index 8789f111d..46017cccd 100644 --- a/src/map/lapack2flamec/f2c/c/sgemlqt.c +++ b/src/map/lapack2flamec/f2c/c/sgemlqt.c @@ -155,7 +155,7 @@ int sgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine -- */ @@ -243,7 +243,7 @@ int sgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGEMLQT", &i__1); + xerbla_("SGEMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgemqr.c b/src/map/lapack2flamec/f2c/c/sgemqr.c index 6aa8ee37a..e2e015ef4 100644 --- a/src/map/lapack2flamec/f2c/c/sgemqr.c +++ b/src/map/lapack2flamec/f2c/c/sgemqr.c @@ -175,9 +175,8 @@ int sgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, real *a logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int sgemqrt_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -228,21 +227,6 @@ int sgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, real *a lw = mb * nb; mn = *n; } - if (mb > *k && mn > *k) - { - if ((mn - *k) % (mb - *k) == 0) - { - nblcks = (mn - *k) / (mb - *k); - } - else - { - nblcks = (mn - *k) / (mb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -287,7 +271,7 @@ int sgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SGEMQR", &i__1); + xerbla_("SGEMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgemqrt.c b/src/map/lapack2flamec/f2c/c/sgemqrt.c index 82aa94450..823013b3b 100644 --- a/src/map/lapack2flamec/f2c/c/sgemqrt.c +++ b/src/map/lapack2flamec/f2c/c/sgemqrt.c @@ -167,7 +167,7 @@ int sgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -256,7 +256,7 @@ int sgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGEMQRT", &i__1); + xerbla_("SGEMQRT", &i__1, (ftnlen)7); return 0; } /* .. Quick return if possible .. */ diff --git a/src/map/lapack2flamec/f2c/c/sgeql2.c b/src/map/lapack2flamec/f2c/c/sgeql2.c index 0abe7e136..a1b55eb60 100644 --- a/src/map/lapack2flamec/f2c/c/sgeql2.c +++ b/src/map/lapack2flamec/f2c/c/sgeql2.c @@ -122,7 +122,7 @@ int sgeql2_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work integer i__, k; real aii; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -165,7 +165,7 @@ int sgeql2_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQL2", &i__1); + xerbla_("SGEQL2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/c/sgeqlf.c b/src/map/lapack2flamec/f2c/c/sgeqlf.c index 642ff6dd9..f3bec6123 100644 --- a/src/map/lapack2flamec/f2c/c/sgeqlf.c +++ b/src/map/lapack2flamec/f2c/c/sgeqlf.c @@ -140,7 +140,7 @@ int sgeqlf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sgeql2_(integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgeql2_(integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -186,6 +186,7 @@ int sgeqlf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work { *info = -4; } + nb = ilaenv_(&c__1, "SGEQLF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { k = fla_min(*m,*n); @@ -195,7 +196,6 @@ int sgeqlf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work } else { - nb = ilaenv_(&c__1, "SGEQLF", " ", m, n, &c_n1, &c_n1); lwkopt = *n * nb; } work[1] = (real) lwkopt; @@ -207,7 +207,7 @@ int sgeqlf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQLF", &i__1); + xerbla_("SGEQLF", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgeqr.c b/src/map/lapack2flamec/f2c/c/sgeqr.c index 92f16d4a2..16e924aee 100644 --- a/src/map/lapack2flamec/f2c/c/sgeqr.c +++ b/src/map/lapack2flamec/f2c/c/sgeqr.c @@ -178,7 +178,7 @@ int sgeqr_(integer *m, integer *n, real *a, integer *lda, real *t, integer *tsiz logical mint, minw; integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgeqrt_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -346,7 +346,7 @@ int sgeqr_(integer *m, integer *n, real *a, integer *lda, real *t, integer *tsiz if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQR", &i__1); + xerbla_("SGEQR", &i__1, (ftnlen)5); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgeqrt.c b/src/map/lapack2flamec/f2c/c/sgeqrt.c index e2aed0950..81cdffe8c 100644 --- a/src/map/lapack2flamec/f2c/c/sgeqrt.c +++ b/src/map/lapack2flamec/f2c/c/sgeqrt.c @@ -135,7 +135,7 @@ int sgeqrt_(integer *m, integer *n, integer *nb, real *a, integer *lda, real *t, /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *), sgeqrt2_( integer *, integer *, real *, integer *, real *, integer *, integer *), sgeqrt3_(integer *, integer *, real *, integer *, real *, integer *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgeqrt2_( integer *, integer *, real *, integer *, real *, integer *, integer *), sgeqrt3_(integer *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int sgeqrt_(integer *m, integer *n, integer *nb, real *a, integer *lda, real *t, if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRT", &i__1); + xerbla_("SGEQRT", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgeqrt2.c b/src/map/lapack2flamec/f2c/c/sgeqrt2.c index 5de5fa155..fc5020785 100644 --- a/src/map/lapack2flamec/f2c/c/sgeqrt2.c +++ b/src/map/lapack2flamec/f2c/c/sgeqrt2.c @@ -131,7 +131,7 @@ int sgeqrt2_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *); real alpha; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int sgeqrt2_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRT2", &i__1); + xerbla_("SGEQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgeqrt3.c b/src/map/lapack2flamec/f2c/c/sgeqrt3.c index a85be2dcb..1ee17b819 100644 --- a/src/map/lapack2flamec/f2c/c/sgeqrt3.c +++ b/src/map/lapack2flamec/f2c/c/sgeqrt3.c @@ -131,7 +131,7 @@ int sgeqrt3_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld /* Local variables */ integer i__, j, i1, j1, n1, n2, iinfo; extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int sgeqrt3_(integer *m, integer *n, real *a, integer *lda, real *t, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRT3", &i__1); + xerbla_("SGEQRT3", &i__1, (ftnlen)7); return 0; } if (*n == 1) diff --git a/src/map/lapack2flamec/f2c/c/sgerfs.c b/src/map/lapack2flamec/f2c/c/sgerfs.c index acbb8a9cd..2d6bf227f 100644 --- a/src/map/lapack2flamec/f2c/c/sgerfs.c +++ b/src/map/lapack2flamec/f2c/c/sgerfs.c @@ -196,7 +196,7 @@ int sgerfs_(char *trans, integer *n, integer *nrhs, real *a, integer *lda, real extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -277,7 +277,7 @@ int sgerfs_(char *trans, integer *n, integer *nrhs, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGERFS", &i__1); + xerbla_("SGERFS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgerfsx.c b/src/map/lapack2flamec/f2c/c/sgerfsx.c index 1f3eaeeb4..66f1f4a40 100644 --- a/src/map/lapack2flamec/f2c/c/sgerfsx.c +++ b/src/map/lapack2flamec/f2c/c/sgerfsx.c @@ -434,7 +434,7 @@ int sgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, real *a, inte real anorm; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *), sgecon_( char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgecon_( char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); logical colequ, notran, rowequ; extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -587,7 +587,7 @@ int sgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, real *a, inte if (*info != 0) { i__1 = -(*info); - xerbla_("SGERFSX", &i__1); + xerbla_("SGERFSX", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sgerq2.c b/src/map/lapack2flamec/f2c/c/sgerq2.c index d0e9078e6..ee27cd9b1 100644 --- a/src/map/lapack2flamec/f2c/c/sgerq2.c +++ b/src/map/lapack2flamec/f2c/c/sgerq2.c @@ -120,7 +120,7 @@ int sgerq2_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work integer i__, k; real aii; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int sgerq2_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("SGERQ2", &i__1); + xerbla_("SGERQ2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/c/sgerqf.c b/src/map/lapack2flamec/f2c/c/sgerqf.c index bbca7db46..e57f3e44a 100644 --- a/src/map/lapack2flamec/f2c/c/sgerqf.c +++ b/src/map/lapack2flamec/f2c/c/sgerqf.c @@ -142,7 +142,7 @@ int sgerqf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -187,6 +187,7 @@ int sgerqf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work { *info = -4; } + nb = ilaenv_(&c__1, "SGERQF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { k = fla_min(*m,*n); @@ -196,7 +197,6 @@ int sgerqf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work } else { - nb = ilaenv_(&c__1, "SGERQF", " ", m, n, &c_n1, &c_n1); lwkopt = *m * nb; } work[1] = (real) lwkopt; @@ -211,7 +211,7 @@ int sgerqf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("SGERQF", &i__1); + xerbla_("SGERQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgesv.c b/src/map/lapack2flamec/f2c/c/sgesv.c index 4a8d57a45..7a32d70f3 100644 --- a/src/map/lapack2flamec/f2c/c/sgesv.c +++ b/src/map/lapack2flamec/f2c/c/sgesv.c @@ -116,7 +116,7 @@ int sgesv_(integer *n, integer *nrhs, real *a, integer *lda, integer *ipiv, real integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), sgetrf_( integer *, integer *, real *, integer *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgetrf_( integer *, integer *, real *, integer *, integer *, integer *), sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -161,7 +161,7 @@ int sgesv_(integer *n, integer *nrhs, real *a, integer *lda, integer *ipiv, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGESV ", &i__1); + xerbla_("SGESV ", &i__1, (ftnlen)6); return 0; } /* Compute the LU factorization of A. */ diff --git a/src/map/lapack2flamec/f2c/c/sgesvdq.c b/src/map/lapack2flamec/f2c/c/sgesvdq.c index ddd67a2da..cc91fb139 100644 --- a/src/map/lapack2flamec/f2c/c/sgesvdq.c +++ b/src/map/lapack2flamec/f2c/c/sgesvdq.c @@ -456,7 +456,7 @@ int sgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer real sconda; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *), sgelqf_( integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgelqf_( integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgesvd_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slapmt_(logical *, integer *, integer *, real *, integer *, integer *), spocon_(char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); @@ -526,6 +526,10 @@ int sgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer acclh = lsame_(joba, "H") || conda; rowprm = lsame_(jobp, "P"); rtrans = lsame_(jobr, "T"); + sconda = 0.f; + lworq = 0; + lwrk_sormqr__ = 0; + lwrk_sgeqp3__ = 0; if (rowprm) { if (conda) @@ -934,7 +938,7 @@ int sgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGESVDQ", &i__1); + xerbla_("SGESVDQ", &i__1, (ftnlen)7); return 0; } else if (lquery) @@ -974,7 +978,7 @@ int sgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__2 = -(*info); - xerbla_("SGESVDQ", &i__2); + xerbla_("SGESVDQ", &i__2, (ftnlen)7); return 0; } /* L1904: */ @@ -1065,7 +1069,7 @@ int sgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__1 = -(*info); - xerbla_("SGESVDQ", &i__1); + xerbla_("SGESVDQ", &i__1, (ftnlen)7); return 0; } if (rtmp > big / sqrt((real) (*m))) diff --git a/src/map/lapack2flamec/f2c/c/sgesvdx.c b/src/map/lapack2flamec/f2c/c/sgesvdx.c index 6de430731..e03970cbf 100644 --- a/src/map/lapack2flamec/f2c/c/sgesvdx.c +++ b/src/map/lapack2flamec/f2c/c/sgesvdx.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c__1 = 1; static integer c_n1 = -1; static real c_b109 = 0.f; @@ -268,8 +267,7 @@ the routine */ int sgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, real *a, integer *lda, real *vl, real *vu, integer *il, integer *iu, integer *ns, real *s, real *u, integer *ldu, real *vt, integer *ldvt, real *work, integer *lwork, integer *iwork, integer * info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -294,12 +292,11 @@ int sgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, real int sgebrd_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ int sgelqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); - real abstol; extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); char rngtgk[1]; @@ -351,11 +348,11 @@ int sgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, real /* Function Body */ *ns = 0; *info = 0; - abstol = slamch_("S") * 2; lquery = *lwork == -1; minmn = fla_min(*m,*n); wantu = lsame_(jobu, "V"); wantvt = lsame_(jobvt, "V"); + mnthr = 0; if (wantu || wantvt) { *(unsigned char *)jobz = 'V'; @@ -563,7 +560,7 @@ int sgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, real if (*info != 0) { i__2 = -(*info); - xerbla_("SGESVDX", &i__2); + xerbla_("SGESVDX", &i__2, (ftnlen)7); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgesvj.c b/src/map/lapack2flamec/f2c/c/sgesvj.c index c23b02c99..f7bac9df0 100644 --- a/src/map/lapack2flamec/f2c/c/sgesvj.c +++ b/src/map/lapack2flamec/f2c/c/sgesvj.c @@ -347,7 +347,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, extern real sdot_(integer *, real *, integer *, real *, integer *); real aapp0, temp1; extern real snrm2_(integer *, real *, integer *); - real large, apoaq, aqoap; + real apoaq, aqoap; extern logical lsame_(char *, char *); real theta; extern /* Subroutine */ @@ -363,7 +363,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, int sswap_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), srotm_(integer *, real *, integer *, real *, integer *, real *), sgsvj0_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, integer *), sgsvj1_( char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -479,7 +479,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, if (*info != 0) { i__1 = -(*info); - xerbla_("SGESVJ", &i__1); + xerbla_("SGESVJ", &i__1, (ftnlen)6); return 0; } /* #:) Quick return for void matrix */ @@ -520,7 +520,6 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, big = slamch_("Overflow"); /* BIG = ONE / SFMIN */ rootbig = 1.f / rootsfmin; - large = big / sqrt((real) (*m * *n)); bigtheta = 1.f / rooteps; tol = ctol * epsln; roottol = sqrt(tol); @@ -528,7 +527,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, { *info = -4; i__1 = -(*info); - xerbla_("SGESVJ", &i__1); + xerbla_("SGESVJ", &i__1, (ftnlen)6); return 0; } /* Initialize the right singular vector matrix. */ @@ -569,7 +568,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, { *info = -6; i__2 = -(*info); - xerbla_("SGESVJ", &i__2); + xerbla_("SGESVJ", &i__2, (ftnlen)6); return 0; } aaqq = sqrt(aaqq); @@ -612,7 +611,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, { *info = -6; i__2 = -(*info); - xerbla_("SGESVJ", &i__2); + xerbla_("SGESVJ", &i__2, (ftnlen)6); return 0; } aaqq = sqrt(aaqq); @@ -655,7 +654,7 @@ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, real *a, { *info = -6; i__2 = -(*info); - xerbla_("SGESVJ", &i__2); + xerbla_("SGESVJ", &i__2, (ftnlen)6); return 0; } aaqq = sqrt(aaqq); diff --git a/src/map/lapack2flamec/f2c/c/sgesvx.c b/src/map/lapack2flamec/f2c/c/sgesvx.c index c5d24e2eb..4432c2dbd 100644 --- a/src/map/lapack2flamec/f2c/c/sgesvx.c +++ b/src/map/lapack2flamec/f2c/c/sgesvx.c @@ -356,7 +356,7 @@ int sgesvx_(char *fact, char *trans, integer *n, integer * nrhs, real *a, intege extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); logical nofact; extern /* Subroutine */ - int slaqge_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *), xerbla_(char *, integer *), sgecon_(char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); + int slaqge_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgecon_(char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); real bignum; integer infequ; logical colequ; @@ -417,6 +417,8 @@ int sgesvx_(char *fact, char *trans, integer *n, integer * nrhs, real *a, intege nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -540,7 +542,7 @@ int sgesvx_(char *fact, char *trans, integer *n, integer * nrhs, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGESVX", &i__1); + xerbla_("SGESVX", &i__1, (ftnlen)6); return 0; } if (equil) diff --git a/src/map/lapack2flamec/f2c/c/sgesvxx.c b/src/map/lapack2flamec/f2c/c/sgesvxx.c index 0e43bcfdf..f789587ba 100644 --- a/src/map/lapack2flamec/f2c/c/sgesvxx.c +++ b/src/map/lapack2flamec/f2c/c/sgesvxx.c @@ -555,7 +555,7 @@ int sgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, real *a, integ extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int slaqge_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *), xerbla_(char *, integer *); + int slaqge_(integer *, integer *, real *, integer *, real *, real *, real *, real *, real *, char *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; logical colequ; @@ -747,7 +747,7 @@ int sgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGESVXX", &i__1); + xerbla_("SGESVXX", &i__1, (ftnlen)7); return 0; } if (equil) diff --git a/src/map/lapack2flamec/f2c/c/sgetc2.c b/src/map/lapack2flamec/f2c/c/sgetc2.c index 4b799c666..f1d938ee2 100644 --- a/src/map/lapack2flamec/f2c/c/sgetc2.c +++ b/src/map/lapack2flamec/f2c/c/sgetc2.c @@ -146,6 +146,9 @@ int sgetc2_(integer *n, real *a, integer *lda, integer *ipiv, integer *jpiv, int --jpiv; /* Function Body */ *info = 0; + smin = 0.f; + ipv = 0; + jpv = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/sgetrf2.c b/src/map/lapack2flamec/f2c/c/sgetrf2.c index f4d343576..e76928c98 100644 --- a/src/map/lapack2flamec/f2c/c/sgetrf2.c +++ b/src/map/lapack2flamec/f2c/c/sgetrf2.c @@ -122,7 +122,7 @@ int sgetrf2_(integer *m, integer *n, real *a, integer *lda, integer *ipiv, integ int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); @@ -150,6 +150,7 @@ int sgetrf2_(integer *m, integer *n, real *a, integer *lda, integer *ipiv, integ /* Parameter adjustments */ #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; + static TLS_CLASS_SPEC integer progress_size = 0; #endif a_dim1 = *lda; a_offset = 1 + a_dim1; @@ -172,7 +173,7 @@ int sgetrf2_(integer *m, integer *n, real *a, integer *lda, integer *ipiv, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRF2", &i__1); + xerbla_("SGETRF2", &i__1, (ftnlen)7); return 0; } /* Quick return if possible */ @@ -246,21 +247,20 @@ int sgetrf2_(integer *m, integer *n, real *a, integer *lda, integer *ipiv, integ #endif if(aocl_fla_progress_ptr) { - if(step_count == 0 || step_count==size ){ - size=fla_min(*m,*n); - step_count =1; - } + if(progress_step_count == 0 || progress_step_count == progress_size ) + { + progress_size = fla_min(*m,*n); + progress_step_count = 1; + } - if(!(step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) - { - - - ++step_count; - if((step_count%8)==0 || step_count==size) + if(!(progress_step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) + { + ++progress_step_count; + if((progress_step_count%8)==0 || progress_step_count == progress_size) { - AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF2",7,&step_count,&thread_id,&total_threads); + AOCL_FLA_PROGRESS_FUNC_PTR("SGETRF2",7,&progress_step_count,&progress_thread_id,&progress_total_threads); } - } + } } #endif diff --git a/src/map/lapack2flamec/f2c/c/sgetri.c b/src/map/lapack2flamec/f2c/c/sgetri.c index 2e5e77062..827420601 100644 --- a/src/map/lapack2flamec/f2c/c/sgetri.c +++ b/src/map/lapack2flamec/f2c/c/sgetri.c @@ -116,7 +116,7 @@ int sgetri_(integer *n, real *a, integer *lda, integer *ipiv, real *work, intege /* Local variables */ integer i__, j, jb, nb, jj, jp, nn, iws, nbmin; extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -170,7 +170,7 @@ int sgetri_(integer *n, real *a, integer *lda, integer *ipiv, real *work, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRI", &i__1); + xerbla_("SGETRI", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgetrs.c b/src/map/lapack2flamec/f2c/c/sgetrs.c index 7fc9fa687..5c81cf8c6 100644 --- a/src/map/lapack2flamec/f2c/c/sgetrs.c +++ b/src/map/lapack2flamec/f2c/c/sgetrs.c @@ -119,7 +119,7 @@ int sgetrs_(char *trans, integer *n, integer *nrhs, real *a, integer *lda, integ /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); @@ -178,7 +178,7 @@ int sgetrs_(char *trans, integer *n, integer *nrhs, real *a, integer *lda, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGETRS", &i__1); + xerbla_("SGETRS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/sgetsls.c b/src/map/lapack2flamec/f2c/c/sgetsls.c index d31dd0071..fb7f5223c 100644 --- a/src/map/lapack2flamec/f2c/c/sgetsls.c +++ b/src/map/lapack2flamec/f2c/c/sgetsls.c @@ -184,7 +184,7 @@ int sgetsls_(char *trans, integer *m, integer *n, integer * nrhs, real *a, integ int slabad_(real *, real *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer scllen; real bignum; extern /* Subroutine */ @@ -310,7 +310,7 @@ int sgetsls_(char *trans, integer *m, integer *n, integer * nrhs, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SGETSLS", &i__1); + xerbla_("SGETSLS", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgetsqrhrt.c b/src/map/lapack2flamec/f2c/c/sgetsqrhrt.c index 858b3e3c0..13ac21504 100644 --- a/src/map/lapack2flamec/f2c/c/sgetsqrhrt.c +++ b/src/map/lapack2flamec/f2c/c/sgetsqrhrt.c @@ -177,7 +177,7 @@ int sgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 int sorhr_col_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); integer lw1, lw2, num_all_row_blocks__, lwt, ldwt, iinfo; extern /* Subroutine */ - int sorgtsqr_row_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorgtsqr_row_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int slatsqr_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); @@ -296,7 +296,7 @@ int sgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 if (*info != 0) { i__1 = -(*info); - xerbla_("SGETSQRHRT", &i__1); + xerbla_("SGETSQRHRT", &i__1, (ftnlen)10); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sggbak.c b/src/map/lapack2flamec/f2c/c/sggbak.c index 387cf903b..1e5647535 100644 --- a/src/map/lapack2flamec/f2c/c/sggbak.c +++ b/src/map/lapack2flamec/f2c/c/sggbak.c @@ -149,7 +149,7 @@ int sggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real int sscal_(integer *, real *, real *, integer *); logical leftv; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical rightv; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -218,7 +218,7 @@ int sggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGGBAK", &i__1); + xerbla_("SGGBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggbal.c b/src/map/lapack2flamec/f2c/c/sggbal.c index c387b5966..93ea3b7f4 100644 --- a/src/map/lapack2flamec/f2c/c/sggbal.c +++ b/src/map/lapack2flamec/f2c/c/sggbal.c @@ -205,7 +205,7 @@ int sggbal_(char *job, integer *n, real *a, integer *lda, real *b, integer *ldb, real pgamma; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); integer lsfmin, lsfmax; /* -- LAPACK computational routine -- */ @@ -259,7 +259,7 @@ int sggbal_(char *job, integer *n, real *a, integer *lda, real *b, integer *ldb, if (*info != 0) { i__1 = -(*info); - xerbla_("SGGBAL", &i__1); + xerbla_("SGGBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgges.c b/src/map/lapack2flamec/f2c/c/sgges.c index 8aea48a1c..0d62d8132 100644 --- a/src/map/lapack2flamec/f2c/c/sgges.c +++ b/src/map/lapack2flamec/f2c/c/sgges.c @@ -281,7 +281,7 @@ the routine */ /* > \ingroup realGEeigen */ /* ===================================================================== */ /* Subroutine */ -int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork, logical *bwork, integer *info) +int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fps3 selctg, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork, logical *bwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, vsl_dim1, vsl_offset, vsr_dim1, vsr_offset, i__1, i__2; @@ -309,7 +309,7 @@ int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, real int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); real safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -482,7 +482,7 @@ int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGGES ", &i__1); + xerbla_("SGGES ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgges3.c b/src/map/lapack2flamec/f2c/c/sgges3.c index 1560f6db3..97b7c5d6f 100644 --- a/src/map/lapack2flamec/f2c/c/sgges3.c +++ b/src/map/lapack2flamec/f2c/c/sgges3.c @@ -279,7 +279,7 @@ the routine */ /* > \ingroup realGEeigen */ /* ===================================================================== */ /* Subroutine */ -int sgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork, logical *bwork, integer *info) +int sgges3_(char *jobvsl, char *jobvsr, char *sort, L_fps3 selctg, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sgges3 inputs: jobvsl %c, jobvsr %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS "",*jobvsl, *jobvsr, *sort, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr); @@ -308,7 +308,7 @@ int sgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, rea extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax, bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -487,7 +487,7 @@ int sgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SGGES3 ", &i__1); + xerbla_("SGGES3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggesx.c b/src/map/lapack2flamec/f2c/c/sggesx.c index f226cd9cb..c2aac101c 100644 --- a/src/map/lapack2flamec/f2c/c/sggesx.c +++ b/src/map/lapack2flamec/f2c/c/sggesx.c @@ -366,7 +366,7 @@ the */ /* > */ /* ===================================================================== */ /* Subroutine */ -int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *rconde, real *rcondv, real *work, integer *lwork, integer *iwork, integer * liwork, logical *bwork, integer *info) +int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fps3 selctg, char *sense, integer *n, real *a, integer *lda, real *b, integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *rconde, real *rcondv, real *work, integer *lwork, integer *iwork, integer * liwork, logical *bwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, vsl_dim1, vsl_offset, vsr_dim1, vsr_offset, i__1, i__2; @@ -395,7 +395,7 @@ int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); real safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -617,7 +617,7 @@ int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in if (*info != 0) { i__1 = -(*info); - xerbla_("SGGESX", &i__1); + xerbla_("SGGESX", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sggev.c b/src/map/lapack2flamec/f2c/c/sggev.c index 1c6f5466d..f979145b7 100644 --- a/src/map/lapack2flamec/f2c/c/sggev.c +++ b/src/map/lapack2flamec/f2c/c/sggev.c @@ -244,7 +244,7 @@ int sggev_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b, logical ilascl, ilbscl; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *), sgghrd_( char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgghrd_( char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); logical ldumma[1]; char chtemp[1]; real bignum; @@ -407,7 +407,7 @@ int sggev_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("SGGEV ", &i__1); + xerbla_("SGGEV ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sggev3.c b/src/map/lapack2flamec/f2c/c/sggev3.c index e01df2a18..ec6a817b0 100644 --- a/src/map/lapack2flamec/f2c/c/sggev3.c +++ b/src/map/lapack2flamec/f2c/c/sggev3.c @@ -245,7 +245,7 @@ int sggev3_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b logical ilascl, ilbscl; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical ldumma[1]; char chtemp[1]; real bignum; @@ -425,7 +425,7 @@ int sggev3_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b if (*info != 0) { i__1 = -(*info); - xerbla_("SGGEV3 ", &i__1); + xerbla_("SGGEV3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggevx.c b/src/map/lapack2flamec/f2c/c/sggevx.c index d52fc5cb9..de3807eb2 100644 --- a/src/map/lapack2flamec/f2c/c/sggevx.c +++ b/src/map/lapack2flamec/f2c/c/sggevx.c @@ -415,7 +415,7 @@ int sggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, re logical ilascl, ilbscl; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), sgghrd_( char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgghrd_( char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); logical ldumma[1]; char chtemp[1]; real bignum; @@ -625,7 +625,7 @@ int sggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, re if (*info != 0) { i__1 = -(*info); - xerbla_("SGGEVX", &i__1); + xerbla_("SGGEVX", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sggglm.c b/src/map/lapack2flamec/f2c/c/sggglm.c index 6e28963e0..87e291683 100644 --- a/src/map/lapack2flamec/f2c/c/sggglm.c +++ b/src/map/lapack2flamec/f2c/c/sggglm.c @@ -187,7 +187,7 @@ int sggglm_(integer *n, integer *m, integer *p, real *a, integer *lda, real *b, /* Local variables */ integer i__, nb, np, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sggqrf_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, real *, integer *, integer *); @@ -280,7 +280,7 @@ int sggglm_(integer *n, integer *m, integer *p, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("SGGGLM", &i__1); + xerbla_("SGGGLM", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgghd3.c b/src/map/lapack2flamec/f2c/c/sgghd3.c index 9bf18ef53..9a4dbbe15 100644 --- a/src/map/lapack2flamec/f2c/c/sgghd3.c +++ b/src/map/lapack2flamec/f2c/c/sgghd3.c @@ -265,7 +265,7 @@ int sgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, r int strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *); char compq2[1], compz2[1]; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -361,7 +361,7 @@ int sgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, r if (*info != 0) { i__1 = -(*info); - xerbla_("SGGHD3", &i__1); + xerbla_("SGGHD3", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgghrd.c b/src/map/lapack2flamec/f2c/c/sgghrd.c index e84dca994..03702a8f8 100644 --- a/src/map/lapack2flamec/f2c/c/sgghrd.c +++ b/src/map/lapack2flamec/f2c/c/sgghrd.c @@ -218,7 +218,7 @@ int sgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, r int srot_(integer *, real *, integer *, real *, integer *, real *, real *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icompq; extern /* Subroutine */ int slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *); @@ -338,7 +338,7 @@ int sgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, r if (*info != 0) { i__1 = -(*info); - xerbla_("SGGHRD", &i__1); + xerbla_("SGGHRD", &i__1, (ftnlen)6); return 0; } /* Initialize Q and Z if desired. */ diff --git a/src/map/lapack2flamec/f2c/c/sgglse.c b/src/map/lapack2flamec/f2c/c/sgglse.c index 3bcc65031..1e8630292 100644 --- a/src/map/lapack2flamec/f2c/c/sgglse.c +++ b/src/map/lapack2flamec/f2c/c/sgglse.c @@ -181,7 +181,7 @@ int sgglse_(integer *m, integer *n, integer *p, real *a, integer *lda, real *b, /* Local variables */ integer nb, mn, nr, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sggrqf_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, real *, integer *, integer *); @@ -274,7 +274,7 @@ int sgglse_(integer *m, integer *n, integer *p, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("SGGLSE", &i__1); + xerbla_("SGGLSE", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggqrf.c b/src/map/lapack2flamec/f2c/c/sggqrf.c index fd0a49f01..7beab6dfb 100644 --- a/src/map/lapack2flamec/f2c/c/sggqrf.c +++ b/src/map/lapack2flamec/f2c/c/sggqrf.c @@ -217,7 +217,7 @@ int sggqrf_(integer *n, integer *m, integer *p, real *a, integer *lda, real *tau /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgerqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer * ); @@ -299,7 +299,7 @@ int sggqrf_(integer *n, integer *m, integer *p, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SGGQRF", &i__1); + xerbla_("SGGQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggrqf.c b/src/map/lapack2flamec/f2c/c/sggrqf.c index f840eb441..c1396c22a 100644 --- a/src/map/lapack2flamec/f2c/c/sggrqf.c +++ b/src/map/lapack2flamec/f2c/c/sggrqf.c @@ -216,7 +216,7 @@ int sggrqf_(integer *m, integer *p, integer *n, real *a, integer *lda, real *tau /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgerqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer * ); @@ -298,7 +298,7 @@ int sggrqf_(integer *m, integer *p, integer *n, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SGGRQF", &i__1); + xerbla_("SGGRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sggsvd.c b/src/map/lapack2flamec/f2c/c/sggsvd.c index cf14b5a58..4e0a7ce7f 100644 --- a/src/map/lapack2flamec/f2c/c/sggsvd.c +++ b/src/map/lapack2flamec/f2c/c/sggsvd.c @@ -344,7 +344,7 @@ int sggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *), stgsja_( char *, char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), sggsvp_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stgsja_( char *, char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), sggsvp_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, real *, real *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -436,7 +436,7 @@ int sggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVD", &i__1); + xerbla_("SGGSVD", &i__1, (ftnlen)6); return 0; } /* Compute the Frobenius norm of matrices A and B */ diff --git a/src/map/lapack2flamec/f2c/c/sggsvd3.c b/src/map/lapack2flamec/f2c/c/sggsvd3.c index 6cb220ae9..a7a9d659e 100644 --- a/src/map/lapack2flamec/f2c/c/sggsvd3.c +++ b/src/map/lapack2flamec/f2c/c/sggsvd3.c @@ -362,7 +362,7 @@ int sggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *), stgsja_( char *, char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stgsja_( char *, char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -476,7 +476,7 @@ int sggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVD3", &i__1); + xerbla_("SGGSVD3", &i__1, (ftnlen)7); return 0; } if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sggsvp.c b/src/map/lapack2flamec/f2c/c/sggsvp.c index e04dd2543..964d7eee5 100644 --- a/src/map/lapack2flamec/f2c/c/sggsvp.c +++ b/src/map/lapack2flamec/f2c/c/sggsvp.c @@ -260,7 +260,7 @@ int sggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int sgeqr2_(integer *, integer *, real *, integer *, real *, real *, integer *), sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), sgeqpf_( integer *, integer *, real *, integer *, integer *, real *, real *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slapmt_( logical *, integer *, integer *, real *, integer *, integer *); + int sgeqr2_(integer *, integer *, real *, integer *, real *, real *, integer *), sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgeqpf_( integer *, integer *, real *, integer *, integer *, real *, real *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slapmt_( logical *, integer *, integer *, real *, integer *, integer *); logical forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -355,7 +355,7 @@ int sggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVP", &i__1); + xerbla_("SGGSVP", &i__1, (ftnlen)6); return 0; } /* QR with column pivoting of B: B*P = V*( S11 S12 ) */ diff --git a/src/map/lapack2flamec/f2c/c/sggsvp3.c b/src/map/lapack2flamec/f2c/c/sggsvp3.c index a1e2108b9..7b49011d6 100644 --- a/src/map/lapack2flamec/f2c/c/sggsvp3.c +++ b/src/map/lapack2flamec/f2c/c/sggsvp3.c @@ -280,7 +280,7 @@ int sggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int sgeqp3_(integer *, integer *, real *, integer *, integer *, real *, real *, integer *, integer *), sgeqr2_( integer *, integer *, real *, integer *, real *, real *, integer * ), sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_( char *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slapmt_(logical *, integer *, integer *, real *, integer *, integer *); + int sgeqp3_(integer *, integer *, real *, integer *, integer *, real *, real *, integer *, integer *), sgeqr2_( integer *, integer *, real *, integer *, real *, real *, integer * ), sgerq2_(integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slapmt_(logical *, integer *, integer *, real *, integer *, integer *); logical forwrd; integer lwkopt; logical lquery; @@ -410,7 +410,7 @@ int sggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SGGSVP3", &i__1); + xerbla_("SGGSVP3", &i__1, (ftnlen)7); return 0; } if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sgsvj0.c b/src/map/lapack2flamec/f2c/c/sgsvj0.c index da9cd0979..92120d630 100644 --- a/src/map/lapack2flamec/f2c/c/sgsvj0.c +++ b/src/map/lapack2flamec/f2c/c/sgsvj0.c @@ -233,7 +233,7 @@ int sgsvj0_(char *jobv, integer *m, integer *n, real *a, integer *lda, real *d__ int scopy_(integer *, real *, integer *, real *, integer *); logical rotok; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), srotm_(integer *, real *, integer *, real *, integer *, real *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), srotm_(integer *, real *, integer *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -327,7 +327,7 @@ int sgsvj0_(char *jobv, integer *m, integer *n, real *a, integer *lda, real *d__ if (*info != 0) { i__1 = -(*info); - xerbla_("SGSVJ0", &i__1); + xerbla_("SGSVJ0", &i__1, (ftnlen)6); return 0; } if (rsvec) diff --git a/src/map/lapack2flamec/f2c/c/sgsvj1.c b/src/map/lapack2flamec/f2c/c/sgsvj1.c index e7ee8056b..1e5189ec3 100644 --- a/src/map/lapack2flamec/f2c/c/sgsvj1.c +++ b/src/map/lapack2flamec/f2c/c/sgsvj1.c @@ -243,7 +243,7 @@ int sgsvj1_(char *jobv, integer *m, integer *n, integer *n1, real *a, integer *l extern real sdot_(integer *, real *, integer *, real *, integer *); real aapp0, temp1; extern real snrm2_(integer *, real *, integer *); - real large, apoaq, aqoap; + real apoaq, aqoap; extern logical lsame_(char *, char *); real theta, small_val, fastr[5]; logical applv, rsvec; @@ -251,7 +251,7 @@ int sgsvj1_(char *jobv, integer *m, integer *n, integer *n1, real *a, integer *l int scopy_(integer *, real *, integer *, real *, integer *); logical rotok; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), srotm_(integer *, real *, integer *, real *, integer *, real *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), srotm_(integer *, real *, integer *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -349,7 +349,7 @@ int sgsvj1_(char *jobv, integer *m, integer *n, integer *n1, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SGSVJ1", &i__1); + xerbla_("SGSVJ1", &i__1, (ftnlen)6); return 0; } if (rsvec) @@ -366,7 +366,6 @@ int sgsvj1_(char *jobv, integer *m, integer *n, integer *n1, real *a, integer *l small_val = *sfmin / *eps; big = 1.f / *sfmin; rootbig = 1.f / rootsfmin; - large = big / sqrt((real) (*m * *n)); bigtheta = 1.f / rooteps; roottol = sqrt(*tol); /* .. Initialize the right singular vector matrix .. */ diff --git a/src/map/lapack2flamec/f2c/c/sgtcon.c b/src/map/lapack2flamec/f2c/c/sgtcon.c index f4366dc57..f42fb3ef4 100644 --- a/src/map/lapack2flamec/f2c/c/sgtcon.c +++ b/src/map/lapack2flamec/f2c/c/sgtcon.c @@ -151,7 +151,7 @@ int sgtcon_(char *norm, integer *n, real *dl, real *d__, real *du, real *du2, in extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; logical onenrm; extern /* Subroutine */ @@ -203,7 +203,7 @@ int sgtcon_(char *norm, integer *n, real *dl, real *d__, real *du, real *du2, in if (*info != 0) { i__1 = -(*info); - xerbla_("SGTCON", &i__1); + xerbla_("SGTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgtrfs.c b/src/map/lapack2flamec/f2c/c/sgtrfs.c index 28abab266..9c6ff87dc 100644 --- a/src/map/lapack2flamec/f2c/c/sgtrfs.c +++ b/src/map/lapack2flamec/f2c/c/sgtrfs.c @@ -223,7 +223,7 @@ int sgtrfs_(char *trans, integer *n, integer *nrhs, real *dl, real *d__, real *d extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), slagtm_( char *, integer *, integer *, real *, real *, real *, real *, real *, integer *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slagtm_( char *, integer *, integer *, real *, real *, real *, real *, real *, integer *, real *, real *, integer *); logical notran; char transn[1], transt[1]; real lstres; @@ -297,7 +297,7 @@ int sgtrfs_(char *trans, integer *n, integer *nrhs, real *dl, real *d__, real *d if (*info != 0) { i__1 = -(*info); - xerbla_("SGTRFS", &i__1); + xerbla_("SGTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgtsv.c b/src/map/lapack2flamec/f2c/c/sgtsv.c index 4ba045b13..b55e9c0c8 100644 --- a/src/map/lapack2flamec/f2c/c/sgtsv.c +++ b/src/map/lapack2flamec/f2c/c/sgtsv.c @@ -128,7 +128,7 @@ int sgtsv_(integer *n, integer *nrhs, real *dl, real *d__, real *du, real *b, in integer i__, j; real fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -171,7 +171,7 @@ int sgtsv_(integer *n, integer *nrhs, real *dl, real *d__, real *du, real *b, in if (*info != 0) { i__1 = -(*info); - xerbla_("SGTSV ", &i__1); + xerbla_("SGTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgtsvx.c b/src/map/lapack2flamec/f2c/c/sgtsvx.c index 8862c620e..a4b945c2f 100644 --- a/src/map/lapack2flamec/f2c/c/sgtsvx.c +++ b/src/map/lapack2flamec/f2c/c/sgtsvx.c @@ -300,7 +300,7 @@ int sgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, real *dl, real extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real slangt_(char *, integer *, real *, real *, real *); extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), sgtcon_(char *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *, integer *); @@ -377,7 +377,7 @@ int sgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, real *dl, real if (*info != 0) { i__1 = -(*info); - xerbla_("SGTSVX", &i__1); + xerbla_("SGTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgttrf.c b/src/map/lapack2flamec/f2c/c/sgttrf.c index d1d302577..f6e7704f7 100644 --- a/src/map/lapack2flamec/f2c/c/sgttrf.c +++ b/src/map/lapack2flamec/f2c/c/sgttrf.c @@ -127,7 +127,7 @@ int sgttrf_(integer *n, real *dl, real *d__, real *du, real * du2, integer *ipiv integer i__; real fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int sgttrf_(integer *n, real *dl, real *d__, real *du, real * du2, integer *ipiv { *info = -1; i__1 = -(*info); - xerbla_("SGTTRF", &i__1); + xerbla_("SGTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sgttrs.c b/src/map/lapack2flamec/f2c/c/sgttrs.c index 6dc2c1068..6141c3413 100644 --- a/src/map/lapack2flamec/f2c/c/sgttrs.c +++ b/src/map/lapack2flamec/f2c/c/sgttrs.c @@ -141,7 +141,7 @@ int sgttrs_(char *trans, integer *n, integer *nrhs, real *dl, real *d__, real *d /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int sgtts2_(integer *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *), xerbla_( char *, integer *); + int sgtts2_(integer *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer itrans; logical notran; @@ -194,7 +194,7 @@ int sgttrs_(char *trans, integer *n, integer *nrhs, real *dl, real *d__, real *d if (*info != 0) { i__1 = -(*info); - xerbla_("SGTTRS", &i__1); + xerbla_("SGTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/shgeqz.c b/src/map/lapack2flamec/f2c/c/shgeqz.c index c26261136..02a1cd26c 100644 --- a/src/map/lapack2flamec/f2c/c/shgeqz.c +++ b/src/map/lapack2flamec/f2c/c/shgeqz.c @@ -345,7 +345,7 @@ int shgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ int slarfg_(integer *, real *, real *, integer *, real *); real safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real eshift; logical ilschr; integer icompq, ilastm; @@ -399,6 +399,9 @@ int shgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ z__ -= z_offset; --work; /* Function Body */ + ilz = 0; + ilq = 0; + ilschr = 0; if (lsame_(job, "E")) { ilschr = FALSE_; @@ -502,7 +505,7 @@ int shgeqz_(char *job, char *compq, char *compz, integer *n, integer *ilo, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SHGEQZ", &i__1); + xerbla_("SHGEQZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/shsein.c b/src/map/lapack2flamec/f2c/c/shsein.c index 6f0f0fc0e..2677aad73 100644 --- a/src/map/lapack2flamec/f2c/c/shsein.c +++ b/src/map/lapack2flamec/f2c/c/shsein.c @@ -283,7 +283,7 @@ int shsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, real hnorm; extern real slamch_(char *); extern /* Subroutine */ - int slaein_(logical *, logical *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, real *, real *, real *, integer *), xerbla_(char *, integer *); + int slaein_(logical *, logical *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slanhs_(char *, integer *, real *, integer *, real *); extern logical sisnan_(real *); @@ -405,7 +405,7 @@ int shsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, if (*info != 0) { i__1 = -(*info); - xerbla_("SHSEIN", &i__1); + xerbla_("SHSEIN", &i__1, (ftnlen)6); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/shseqr.c b/src/map/lapack2flamec/f2c/c/shseqr.c index 5bbcac7df..463e71798 100644 --- a/src/map/lapack2flamec/f2c/c/shseqr.c +++ b/src/map/lapack2flamec/f2c/c/shseqr.c @@ -4,7 +4,6 @@ static real c_b11 = 0.f; static real c_b12 = 1.f; static integer c__12 = 12; -static integer c__2 = 2; static integer c__49 = 49; /* > \brief \b SHSEQR */ /* =========== DOCUMENTATION =========== */ @@ -312,8 +311,7 @@ int shseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, real AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("shseqr inputs: job %c, compz %c, n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", ldh %" FLA_IS ", ldz %" FLA_IS "",*job, *compz, *n, *ilo, *ihi, *ldh, *ldz); /* System generated locals */ - address a__1[2]; - integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2[2], i__3; + integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__3; real r__1; char ch__1[2]; /* Builtin functions */ @@ -329,7 +327,7 @@ int shseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, real real workl[49]; logical wantt, wantz; extern /* Subroutine */ - int slaqr0_(logical *, logical *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slaqr0_(logical *, logical *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slahqr_(logical *, logical *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -418,7 +416,7 @@ int shseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, real { /* ==== Quick return in case of invalid argument. ==== */ i__1 = -(*info); - xerbla_("SHSEQR", &i__1); + xerbla_("SHSEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sla_gbamv.c b/src/map/lapack2flamec/f2c/c/sla_gbamv.c index 4e9dbbbba..e7ea965f0 100644 --- a/src/map/lapack2flamec/f2c/c/sla_gbamv.c +++ b/src/map/lapack2flamec/f2c/c/sla_gbamv.c @@ -187,7 +187,7 @@ int sla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, real safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -251,7 +251,7 @@ int sla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, } if (info != 0) { - xerbla_("SLA_GBAMV ", &info); + xerbla_("SLA_GBAMV ", &info, (ftnlen)10); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sla_gbrcond.c b/src/map/lapack2flamec/f2c/c/sla_gbrcond.c index 806387fb2..9d235c650 100644 --- a/src/map/lapack2flamec/f2c/c/sla_gbrcond.c +++ b/src/map/lapack2flamec/f2c/c/sla_gbrcond.c @@ -167,7 +167,7 @@ real sla_gbrcond_(char *trans, integer *n, integer *kl, integer *ku, real * ab, extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -234,7 +234,7 @@ real sla_gbrcond_(char *trans, integer *n, integer *kl, integer *ku, real * ab, if (*info != 0) { i__1 = -(*info); - xerbla_("SLA_GBRCOND", &i__1); + xerbla_("SLA_GBRCOND", &i__1, (ftnlen)11); return ret_val; } if (*n == 0) diff --git a/src/map/lapack2flamec/f2c/c/sla_geamv.c b/src/map/lapack2flamec/f2c/c/sla_geamv.c index fd91b53bd..070bb4ac4 100644 --- a/src/map/lapack2flamec/f2c/c/sla_geamv.c +++ b/src/map/lapack2flamec/f2c/c/sla_geamv.c @@ -176,7 +176,7 @@ int sla_geamv_(integer *trans, integer *m, integer *n, real *alpha, real *a, int real safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -232,7 +232,7 @@ int sla_geamv_(integer *trans, integer *m, integer *n, real *alpha, real *a, int } if (info != 0) { - xerbla_("SLA_GEAMV ", &info); + xerbla_("SLA_GEAMV ", &info, (ftnlen)10); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sla_gercond.c b/src/map/lapack2flamec/f2c/c/sla_gercond.c index 4abe8831d..14dd61e6b 100644 --- a/src/map/lapack2flamec/f2c/c/sla_gercond.c +++ b/src/map/lapack2flamec/f2c/c/sla_gercond.c @@ -149,7 +149,7 @@ real sla_gercond_(char *trans, integer *n, real *a, integer *lda, real *af, inte extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int sgetrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -208,7 +208,7 @@ real sla_gercond_(char *trans, integer *n, real *a, integer *lda, real *af, inte if (*info != 0) { i__1 = -(*info); - xerbla_("SLA_GERCOND", &i__1); + xerbla_("SLA_GERCOND", &i__1, (ftnlen)11); return ret_val; } if (*n == 0) diff --git a/src/map/lapack2flamec/f2c/c/sla_porcond.c b/src/map/lapack2flamec/f2c/c/sla_porcond.c index 1311b37fb..cb777593d 100644 --- a/src/map/lapack2flamec/f2c/c/sla_porcond.c +++ b/src/map/lapack2flamec/f2c/c/sla_porcond.c @@ -140,7 +140,7 @@ real sla_porcond_(char *uplo, integer *n, real *a, integer *lda, real *af, integ extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int spotrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -184,7 +184,7 @@ real sla_porcond_(char *uplo, integer *n, real *a, integer *lda, real *af, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SLA_PORCOND", &i__1); + xerbla_("SLA_PORCOND", &i__1, (ftnlen)11); return ret_val; } if (*n == 0) diff --git a/src/map/lapack2flamec/f2c/c/sla_syamv.c b/src/map/lapack2flamec/f2c/c/sla_syamv.c index 9472da2c3..77ae89d3d 100644 --- a/src/map/lapack2flamec/f2c/c/sla_syamv.c +++ b/src/map/lapack2flamec/f2c/c/sla_syamv.c @@ -176,7 +176,7 @@ int sla_syamv_(integer *uplo, integer *n, real *alpha, real *a, integer *lda, re real temp, safe1; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -229,7 +229,7 @@ int sla_syamv_(integer *uplo, integer *n, real *alpha, real *a, integer *lda, re } if (info != 0) { - xerbla_("SLA_SYAMV", &info); + xerbla_("SLA_SYAMV", &info, (ftnlen)9); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sla_syrcond.c b/src/map/lapack2flamec/f2c/c/sla_syrcond.c index 6a606f0de..aa62656aa 100644 --- a/src/map/lapack2flamec/f2c/c/sla_syrcond.c +++ b/src/map/lapack2flamec/f2c/c/sla_syrcond.c @@ -149,10 +149,9 @@ real sla_syrcond_(char *uplo, integer *n, real *a, integer *lda, real *af, integ int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; char normin[1]; - real smlnum; extern /* Subroutine */ int ssytrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -204,7 +203,7 @@ real sla_syrcond_(char *uplo, integer *n, real *a, integer *lda, real *af, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SLA_SYRCOND", &i__1); + xerbla_("SLA_SYRCOND", &i__1, (ftnlen)11); return ret_val; } if (*n == 0) @@ -344,7 +343,6 @@ real sla_syrcond_(char *uplo, integer *n, real *a, integer *lda, real *af, integ } } /* Estimate the norm of inv(op(A)). */ - smlnum = slamch_("Safe minimum"); ainvnm = 0.f; *(unsigned char *)normin = 'N'; kase = 0; diff --git a/src/map/lapack2flamec/f2c/c/sla_syrfsx_extended.c b/src/map/lapack2flamec/f2c/c/sla_syrfsx_extended.c index 0260cad3c..621c532ee 100644 --- a/src/map/lapack2flamec/f2c/c/sla_syrfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/sla_syrfsx_extended.c @@ -422,7 +422,7 @@ int sla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * int saxpy_(integer *, real *, real *, integer *, real *, integer *), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real normdx; extern /* Subroutine */ int ssytrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -509,7 +509,7 @@ int sla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SLA_SYRFSX_EXTENDED", &i__1); + xerbla_("SLA_SYRFSX_EXTENDED", &i__1, (ftnlen)19); return 0; } eps = slamch_("Epsilon"); diff --git a/src/map/lapack2flamec/f2c/c/slaed0.c b/src/map/lapack2flamec/f2c/c/slaed0.c index f95113063..32d39ae83 100644 --- a/src/map/lapack2flamec/f2c/c/slaed0.c +++ b/src/map/lapack2flamec/f2c/c/slaed0.c @@ -185,7 +185,7 @@ int slaed0_(integer *icompq, integer *qsiz, integer *n, real *d__, real *e, real int slaed1_(integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, integer *), slaed7_(integer *, integer *, integer *, integer *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, integer *, real *, real *, integer *, integer *); integer igivcl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer igivnm, submat; extern /* Subroutine */ @@ -227,6 +227,13 @@ int slaed0_(integer *icompq, integer *qsiz, integer *n, real *d__, real *e, real --iwork; /* Function Body */ *info = 0; + iprmpt = 0; + igivpt = 0; + igivcl = 0; + iqptr = 0; + iwrem = 0; + iperm = 0; + iq = 0; if (*icompq < 0 || *icompq > 2) { *info = -1; @@ -250,7 +257,7 @@ int slaed0_(integer *icompq, integer *qsiz, integer *n, real *d__, real *e, real if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED0", &i__1); + xerbla_("SLAED0", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaed1.c b/src/map/lapack2flamec/f2c/c/slaed1.c index 9b73abef0..656892e7b 100644 --- a/src/map/lapack2flamec/f2c/c/slaed1.c +++ b/src/map/lapack2flamec/f2c/c/slaed1.c @@ -161,7 +161,7 @@ int slaed1_(integer *n, real *d__, real *q, integer *ldq, integer *indxq, real * int scopy_(integer *, real *, integer *, real *, integer *), slaed2_(integer *, integer *, integer *, real *, real *, integer *, integer *, real *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, integer *), slaed3_( integer *, integer *, integer *, real *, real *, integer *, real *, real *, real *, integer *, integer *, real *, real *, integer *) ; integer idlmda; extern /* Subroutine */ - int xerbla_(char *, integer *), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); integer coltyp; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -211,7 +211,7 @@ int slaed1_(integer *n, real *d__, real *q, integer *ldq, integer *indxq, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED1", &i__1); + xerbla_("SLAED1", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaed2.c b/src/map/lapack2flamec/f2c/c/slaed2.c index b1f005d44..2f9432d62 100644 --- a/src/map/lapack2flamec/f2c/c/slaed2.c +++ b/src/map/lapack2flamec/f2c/c/slaed2.c @@ -221,7 +221,7 @@ int slaed2_(integer *k, integer *n, integer *n1, real *d__, real *q, integer *ld int srot_(integer *, real *, integer *, real *, integer *, real *, real *), sscal_(integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer * ); extern real slapy2_(real *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -264,6 +264,7 @@ int slaed2_(integer *k, integer *n, integer *n1, real *d__, real *q, integer *ld --coltyp; /* Function Body */ *info = 0; + pj = 0; if (*n < 0) { *info = -2; @@ -285,7 +286,7 @@ int slaed2_(integer *k, integer *n, integer *n1, real *d__, real *q, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED2", &i__1); + xerbla_("SLAED2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaed3.c b/src/map/lapack2flamec/f2c/c/slaed3.c index f79811138..b68bdf10f 100644 --- a/src/map/lapack2flamec/f2c/c/slaed3.c +++ b/src/map/lapack2flamec/f2c/c/slaed3.c @@ -189,7 +189,7 @@ int slaed3_(integer *k, integer *n, integer *n1, real *d__, real *q, integer *ld int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), slaed4_(integer *, integer *, real *, real *, real *, real *, real *, integer *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -239,7 +239,7 @@ int slaed3_(integer *k, integer *n, integer *n1, real *d__, real *q, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED3", &i__1); + xerbla_("SLAED3", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaed6.c b/src/map/lapack2flamec/f2c/c/slaed6.c index a3aac8fc8..db1cc5fd6 100644 --- a/src/map/lapack2flamec/f2c/c/slaed6.c +++ b/src/map/lapack2flamec/f2c/c/slaed6.c @@ -176,6 +176,7 @@ int slaed6_(integer *kniter, logical *orgati, real *rho, real *d__, real *z__, r --d__; /* Function Body */ *info = 0; + sclinv = 0.f; if (*orgati) { lbd = d__[2]; diff --git a/src/map/lapack2flamec/f2c/c/slaed7.c b/src/map/lapack2flamec/f2c/c/slaed7.c index 96387f279..9dc7578ea 100644 --- a/src/map/lapack2flamec/f2c/c/slaed7.c +++ b/src/map/lapack2flamec/f2c/c/slaed7.c @@ -263,7 +263,7 @@ int slaed7_(integer *icompq, integer *n, integer *qsiz, integer *tlvls, integer int slaed8_(integer *, integer *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *, integer *), slaed9_( integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, real *, real *, integer *, integer *), slaeda_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, integer *); integer idlmda; extern /* Subroutine */ - int xerbla_(char *, integer *), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); integer coltyp; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -324,7 +324,7 @@ int slaed7_(integer *icompq, integer *n, integer *qsiz, integer *tlvls, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED7", &i__1); + xerbla_("SLAED7", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaed8.c b/src/map/lapack2flamec/f2c/c/slaed8.c index e596da5bf..36ada26cd 100644 --- a/src/map/lapack2flamec/f2c/c/slaed8.c +++ b/src/map/lapack2flamec/f2c/c/slaed8.c @@ -247,7 +247,7 @@ int slaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, real *d__, r int srot_(integer *, real *, integer *, real *, integer *, real *, real *), sscal_(integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer * ); extern real slapy2_(real *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -291,6 +291,7 @@ int slaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, real *d__, r --indx; /* Function Body */ *info = 0; + jlam = 0; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -318,7 +319,7 @@ int slaed8_(integer *icompq, integer *k, integer *n, integer *qsiz, real *d__, r if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED8", &i__1); + xerbla_("SLAED8", &i__1, (ftnlen)6); return 0; } /* Need to initialize GIVPTR to O here in case of quick exit */ diff --git a/src/map/lapack2flamec/f2c/c/slaed9.c b/src/map/lapack2flamec/f2c/c/slaed9.c index 2c3e0add1..bcb105dc2 100644 --- a/src/map/lapack2flamec/f2c/c/slaed9.c +++ b/src/map/lapack2flamec/f2c/c/slaed9.c @@ -157,7 +157,7 @@ int slaed9_(integer *k, integer *kstart, integer *kstop, integer *n, real *d__, int scopy_(integer *, real *, integer *, real *, integer *), slaed4_(integer *, integer *, real *, real *, real *, real *, real *, integer *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -216,7 +216,7 @@ int slaed9_(integer *k, integer *kstart, integer *kstop, integer *n, real *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("SLAED9", &i__1); + xerbla_("SLAED9", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slaeda.c b/src/map/lapack2flamec/f2c/c/slaeda.c index 2ba7df409..23a56c78d 100644 --- a/src/map/lapack2flamec/f2c/c/slaeda.c +++ b/src/map/lapack2flamec/f2c/c/slaeda.c @@ -168,7 +168,7 @@ int slaeda_(integer *n, integer *tlvls, integer *curlvl, integer *curpbm, intege int srot_(integer *, real *, integer *, real *, integer *, real *, real *); integer bsiz1, bsiz2, psiz1, psiz2, zptr1; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -207,7 +207,7 @@ int slaeda_(integer *n, integer *tlvls, integer *curlvl, integer *curpbm, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SLAEDA", &i__1); + xerbla_("SLAEDA", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slagtf.c b/src/map/lapack2flamec/f2c/c/slagtf.c index 40ee0f8d0..dea290476 100644 --- a/src/map/lapack2flamec/f2c/c/slagtf.c +++ b/src/map/lapack2flamec/f2c/c/slagtf.c @@ -152,7 +152,7 @@ int slagtf_(integer *n, real *a, real *lambda, real *b, real *c__, real *tol, re real tl, eps, piv1, piv2, temp, mult, scale1, scale2; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int slagtf_(integer *n, real *a, real *lambda, real *b, real *c__, real *tol, re { *info = -1; i__1 = -(*info); - xerbla_("SLAGTF", &i__1); + xerbla_("SLAGTF", &i__1, (ftnlen)6); return 0; } if (*n == 0) diff --git a/src/map/lapack2flamec/f2c/c/slagts.c b/src/map/lapack2flamec/f2c/c/slagts.c index ec2d353aa..308e85490 100644 --- a/src/map/lapack2flamec/f2c/c/slagts.c +++ b/src/map/lapack2flamec/f2c/c/slagts.c @@ -159,7 +159,7 @@ int slagts_(integer *job, integer *n, real *a, real *b, real *c__, real *d__, in real ak, eps, temp, pert, absak, sfmin; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -201,7 +201,7 @@ int slagts_(integer *job, integer *n, real *a, real *b, real *c__, real *d__, in if (*info != 0) { i__1 = -(*info); - xerbla_("SLAGTS", &i__1); + xerbla_("SLAGTS", &i__1, (ftnlen)6); return 0; } if (*n == 0) diff --git a/src/map/lapack2flamec/f2c/c/slahqr.c b/src/map/lapack2flamec/f2c/c/slahqr.c index 7e6bb664d..741ef946c 100644 --- a/src/map/lapack2flamec/f2c/c/slahqr.c +++ b/src/map/lapack2flamec/f2c/c/slahqr.c @@ -263,6 +263,7 @@ int slahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i z__ -= z_offset; /* Function Body */ *info = 0; + i2 = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/slahr2.c b/src/map/lapack2flamec/f2c/c/slahr2.c index 9dfc71f35..d070c3787 100644 --- a/src/map/lapack2flamec/f2c/c/slahr2.c +++ b/src/map/lapack2flamec/f2c/c/slahr2.c @@ -215,6 +215,7 @@ int slahr2_(integer *n, integer *k, integer *nb, real *a, integer *lda, real *ta y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei = 0; if (*n <= 1) { return 0; diff --git a/src/map/lapack2flamec/f2c/c/slahrd.c b/src/map/lapack2flamec/f2c/c/slahrd.c index 7f4f9a165..c7ccce980 100644 --- a/src/map/lapack2flamec/f2c/c/slahrd.c +++ b/src/map/lapack2flamec/f2c/c/slahrd.c @@ -203,6 +203,7 @@ int slahrd_(integer *n, integer *k, integer *nb, real *a, integer *lda, real *ta y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei = 0.f; if (*n <= 1) { return 0; diff --git a/src/map/lapack2flamec/f2c/c/slaln2.c b/src/map/lapack2flamec/f2c/c/slaln2.c index 51d135f37..11498e89a 100644 --- a/src/map/lapack2flamec/f2c/c/slaln2.c +++ b/src/map/lapack2flamec/f2c/c/slaln2.c @@ -203,6 +203,12 @@ /* > \ingroup realOTHERauxiliary */ /* ===================================================================== */ /* Subroutine */ + +/* Set FP_contract to off as floating point contraction instructions */ +/* like fma is seen to lead precision issues in this function and */ +/* causing few netlib tests to fail */ +#pragma STDC FP_CONTRACT OFF + int slaln2_(logical *ltrans, integer *na, integer *nw, real * smin, real *ca, real *a, integer *lda, real *d1, real *d2, real *b, integer *ldb, real *wr, real *wi, real *x, integer *ldx, real *scale, real *xnorm, integer *info) { /* Initialized data */ diff --git a/src/map/lapack2flamec/f2c/c/slals0.c b/src/map/lapack2flamec/f2c/c/slals0.c index 0219cecdd..504423d71 100644 --- a/src/map/lapack2flamec/f2c/c/slals0.c +++ b/src/map/lapack2flamec/f2c/c/slals0.c @@ -277,7 +277,7 @@ int slals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n int sscal_(integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_( integer *, real *, integer *, real *, integer *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real dsigjp; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -327,6 +327,7 @@ int slals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n --work; /* Function Body */ *info = 0; + difrj = 0.f; n = *nl + *nr + 1; if (*icompq < 0 || *icompq > 1) { @@ -375,7 +376,7 @@ int slals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n if (*info != 0) { i__1 = -(*info); - xerbla_("SLALS0", &i__1); + xerbla_("SLALS0", &i__1, (ftnlen)6); return 0; } m = n + *sqre; diff --git a/src/map/lapack2flamec/f2c/c/slalsa.c b/src/map/lapack2flamec/f2c/c/slalsa.c index a70a238be..648448728 100644 --- a/src/map/lapack2flamec/f2c/c/slalsa.c +++ b/src/map/lapack2flamec/f2c/c/slalsa.c @@ -268,7 +268,7 @@ int slalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, real *b int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); integer ndimr; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), slals0_(integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), slals0_(integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -363,7 +363,7 @@ int slalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, real *b if (*info != 0) { i__1 = -(*info); - xerbla_("SLALSA", &i__1); + xerbla_("SLALSA", &i__1, (ftnlen)6); return 0; } /* Book-keeping and setting up the computation tree. */ diff --git a/src/map/lapack2flamec/f2c/c/slalsd.c b/src/map/lapack2flamec/f2c/c/slalsd.c index 87486b7f9..5d5558cab 100644 --- a/src/map/lapack2flamec/f2c/c/slalsd.c +++ b/src/map/lapack2flamec/f2c/c/slalsd.c @@ -198,7 +198,7 @@ int slalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, real *d__, r integer nwork, icmpq1, icmpq2; extern real slamch_(char *); extern /* Subroutine */ - int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *), slalsa_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); + int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slalsa_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); integer givcol; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ @@ -255,7 +255,7 @@ int slalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, real *d__, r if (*info != 0) { i__1 = -(*info); - xerbla_("SLALSD", &i__1); + xerbla_("SLALSD", &i__1, (ftnlen)6); return 0; } eps = slamch_("Epsilon"); diff --git a/src/map/lapack2flamec/f2c/c/slamswlq.c b/src/map/lapack2flamec/f2c/c/slamswlq.c index 66db4a509..933a48d62 100644 --- a/src/map/lapack2flamec/f2c/c/slamswlq.c +++ b/src/map/lapack2flamec/f2c/c/slamswlq.c @@ -203,7 +203,7 @@ int slamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int sgemlqt_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stpmlqt_(char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -292,7 +292,7 @@ int slamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("SLAMSWLQ", &i__1); + xerbla_("SLAMSWLQ", &i__1, (ftnlen)8); work[1] = (real) lw; AOCL_DTL_TRACE_LOG_EXIT return 0; diff --git a/src/map/lapack2flamec/f2c/c/slamtsqr.c b/src/map/lapack2flamec/f2c/c/slamtsqr.c index 7ea608e53..e6f894154 100644 --- a/src/map/lapack2flamec/f2c/c/slamtsqr.c +++ b/src/map/lapack2flamec/f2c/c/slamtsqr.c @@ -206,7 +206,7 @@ int slamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int sgemqrt_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stpmqrt_(char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -302,7 +302,7 @@ int slamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("SLAMTSQR", &i__1); + xerbla_("SLAMTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slangb.c b/src/map/lapack2flamec/f2c/c/slangb.c index 5879822b7..c60128a33 100644 --- a/src/map/lapack2flamec/f2c/c/slangb.c +++ b/src/map/lapack2flamec/f2c/c/slangb.c @@ -151,6 +151,7 @@ real slangb_(char *norm, integer *n, integer *kl, integer *ku, real *ab, integer ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slange.c b/src/map/lapack2flamec/f2c/c/slange.c index 62244b81f..7d0b5db84 100644 --- a/src/map/lapack2flamec/f2c/c/slange.c +++ b/src/map/lapack2flamec/f2c/c/slange.c @@ -142,6 +142,7 @@ real slange_(char *norm, integer *m, integer *n, real *a, integer *lda, real * w a -= a_offset; --work; /* Function Body */ + value = 0.f; if (fla_min(*m,*n) == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slangt.c b/src/map/lapack2flamec/f2c/c/slangt.c index 00839b209..d9a191252 100644 --- a/src/map/lapack2flamec/f2c/c/slangt.c +++ b/src/map/lapack2flamec/f2c/c/slangt.c @@ -139,6 +139,7 @@ real slangt_(char *norm, integer *n, real *dl, real *d__, real *du) --d__; --dl; /* Function Body */ + anorm = 0.f; if (*n <= 0) { anorm = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slanhs.c b/src/map/lapack2flamec/f2c/c/slanhs.c index 3a863975a..de328071b 100644 --- a/src/map/lapack2flamec/f2c/c/slanhs.c +++ b/src/map/lapack2flamec/f2c/c/slanhs.c @@ -137,6 +137,7 @@ real slanhs_(char *norm, integer *n, real *a, integer *lda, real *work) a -= a_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slansb.c b/src/map/lapack2flamec/f2c/c/slansb.c index eab674b61..9e74ff04e 100644 --- a/src/map/lapack2flamec/f2c/c/slansb.c +++ b/src/map/lapack2flamec/f2c/c/slansb.c @@ -157,6 +157,7 @@ real slansb_(char *norm, char *uplo, integer *n, integer *k, real *ab, integer * ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slansf.c b/src/map/lapack2flamec/f2c/c/slansf.c index dc5f06b5a..9c5e414aa 100644 --- a/src/map/lapack2flamec/f2c/c/slansf.c +++ b/src/map/lapack2flamec/f2c/c/slansf.c @@ -245,6 +245,7 @@ real slansf_(char *norm, char *transr, char *uplo, integer *n, real *a, real * w /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + value = 0.f; if (*n == 0) { ret_val = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slansp.c b/src/map/lapack2flamec/f2c/c/slansp.c index 195b8580c..253c5757c 100644 --- a/src/map/lapack2flamec/f2c/c/slansp.c +++ b/src/map/lapack2flamec/f2c/c/slansp.c @@ -141,6 +141,7 @@ real slansp_(char *norm, char *uplo, integer *n, real *ap, real *work) --work; --ap; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slanst.c b/src/map/lapack2flamec/f2c/c/slanst.c index 87b01f645..625b1f01d 100644 --- a/src/map/lapack2flamec/f2c/c/slanst.c +++ b/src/map/lapack2flamec/f2c/c/slanst.c @@ -132,6 +132,7 @@ real slanst_(char *norm, integer *n, real *d__, real *e) --e; --d__; /* Function Body */ + anorm = 0.f; if (*n <= 0) { anorm = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slansy.c b/src/map/lapack2flamec/f2c/c/slansy.c index b3603ebd9..5890e13fa 100644 --- a/src/map/lapack2flamec/f2c/c/slansy.c +++ b/src/map/lapack2flamec/f2c/c/slansy.c @@ -150,6 +150,7 @@ real slansy_(char *norm, char *uplo, integer *n, real *a, integer *lda, real * w a -= a_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slantb.c b/src/map/lapack2flamec/f2c/c/slantb.c index 69c450345..5779a7cbf 100644 --- a/src/map/lapack2flamec/f2c/c/slantb.c +++ b/src/map/lapack2flamec/f2c/c/slantb.c @@ -169,6 +169,7 @@ real slantb_(char *norm, char *uplo, char *diag, integer *n, integer *k, real *a ab -= ab_offset; --work; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slantp.c b/src/map/lapack2flamec/f2c/c/slantp.c index be92d2d98..fdce3e013 100644 --- a/src/map/lapack2flamec/f2c/c/slantp.c +++ b/src/map/lapack2flamec/f2c/c/slantp.c @@ -152,6 +152,7 @@ real slantp_(char *norm, char *uplo, char *diag, integer *n, real *ap, real * wo --work; --ap; /* Function Body */ + value = 0.f; if (*n == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slantr.c b/src/map/lapack2flamec/f2c/c/slantr.c index f894c54af..afeb863c6 100644 --- a/src/map/lapack2flamec/f2c/c/slantr.c +++ b/src/map/lapack2flamec/f2c/c/slantr.c @@ -169,6 +169,7 @@ real slantr_(char *norm, char *uplo, char *diag, integer *m, integer *n, real *a a -= a_offset; --work; /* Function Body */ + value = 0.f; if (fla_min(*m,*n) == 0) { value = 0.f; diff --git a/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp.c b/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp.c index 6eed96dff..0dbc17fe7 100644 --- a/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp.c +++ b/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp.c @@ -156,7 +156,7 @@ int slaorhr_col_getrfnp_(integer *m, integer *n, real *a, integer *lda, real *d_ int slaorhr_col_getrfnp2_(integer *, integer *, real *, integer *, real *, integer *); integer iinfo; extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -201,7 +201,7 @@ int slaorhr_col_getrfnp_(integer *m, integer *n, real *a, integer *lda, real *d_ if (*info != 0) { i__1 = -(*info); - xerbla_("SLAORHR_COL_GETRFNP", &i__1); + xerbla_("SLAORHR_COL_GETRFNP", &i__1, (ftnlen)19); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp2.c b/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp2.c index 3665ad459..cffc2e426 100644 --- a/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp2.c +++ b/src/map/lapack2flamec/f2c/c/slaorhr_col_getrfnp2.c @@ -182,7 +182,7 @@ int slaorhr_col_getrfnp2_(integer *m, integer *n, real *a, integer *lda, real *d int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -226,7 +226,7 @@ int slaorhr_col_getrfnp2_(integer *m, integer *n, real *a, integer *lda, real *d if (*info != 0) { i__1 = -(*info); - xerbla_("SLAORHR_COL_GETRFNP2", &i__1); + xerbla_("SLAORHR_COL_GETRFNP2", &i__1, (ftnlen)20); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slaqr0.c b/src/map/lapack2flamec/f2c/c/slaqr0.c index a12482f3e..c957b39fb 100644 --- a/src/map/lapack2flamec/f2c/c/slaqr0.c +++ b/src/map/lapack2flamec/f2c/c/slaqr0.c @@ -329,6 +329,7 @@ int slaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/slaqr4.c b/src/map/lapack2flamec/f2c/c/slaqr4.c index 054bf1d16..492440f6e 100644 --- a/src/map/lapack2flamec/f2c/c/slaqr4.c +++ b/src/map/lapack2flamec/f2c/c/slaqr4.c @@ -338,6 +338,7 @@ int slaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/slaqz0.c b/src/map/lapack2flamec/f2c/c/slaqz0.c index 1b3330df4..9d8721fd7 100644 --- a/src/map/lapack2flamec/f2c/c/slaqz0.c +++ b/src/map/lapack2flamec/f2c/c/slaqz0.c @@ -338,7 +338,7 @@ int slaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real eshift; @@ -349,8 +349,6 @@ int slaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in integer iwantq, iwants, istart; real smlnum; integer istopm, iwantz, istart2; - extern /* Subroutine */ - int f90_exit_(void); logical ilschur; integer nshifts, istartm; /* Arguments */ @@ -376,6 +374,7 @@ int slaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in z__ -= z_offset; --work; /* Function Body */ + eshift = 0.f; if (lsame_(wants, "E")) { ilschur = FALSE_; @@ -473,7 +472,7 @@ int slaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in if (*info != 0) { i__1 = -(*info); - xerbla_("SLAQZ0", &i__1); + xerbla_("SLAQZ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -545,7 +544,7 @@ int slaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in } if (*info != 0) { - xerbla_("SLAQZ0", info); + xerbla_("SLAQZ0", info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slaqz3.c b/src/map/lapack2flamec/f2c/c/slaqz3.c index d4aa6caba..5fec55e4e 100644 --- a/src/map/lapack2flamec/f2c/c/slaqz3.c +++ b/src/map/lapack2flamec/f2c/c/slaqz3.c @@ -258,7 +258,7 @@ int slaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), stgexc_( logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *), slartg_(real *, real *, real *, real *, real *); @@ -342,7 +342,7 @@ int slaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("SLAQZ3", &i__1); + xerbla_("SLAQZ3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slaqz4.c b/src/map/lapack2flamec/f2c/c/slaqz4.c index fe62569cf..2d73c0460 100644 --- a/src/map/lapack2flamec/f2c/c/slaqz4.c +++ b/src/map/lapack2flamec/f2c/c/slaqz4.c @@ -216,7 +216,7 @@ int slaqz4_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i int srot_(integer *, real *, integer *, real *, integer *, real *, real *), sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), slaqz1_(real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *), slaqz2_(logical *, logical *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *, integer *, real *, integer *); integer nblock; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ishift; extern /* Subroutine */ int slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -268,7 +268,7 @@ int slaqz4_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("SLAQZ4", &i__1); + xerbla_("SLAQZ4", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slarrd.c b/src/map/lapack2flamec/f2c/c/slarrd.c index 123dfd8f6..6a9c5370b 100644 --- a/src/map/lapack2flamec/f2c/c/slarrd.c +++ b/src/map/lapack2flamec/f2c/c/slarrd.c @@ -389,6 +389,8 @@ int slarrd_(char *range, char *order, integer *n, real *vl, real *vu, integer *i --gers; /* Function Body */ *info = 0; + wul = 0.f; + wlu = 0.f; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/slarre.c b/src/map/lapack2flamec/f2c/c/slarre.c index 5fbe94b70..12ce28acf 100644 --- a/src/map/lapack2flamec/f2c/c/slarre.c +++ b/src/map/lapack2flamec/f2c/c/slarre.c @@ -378,6 +378,9 @@ int slarre_(char *range, integer *n, real *vl, real *vu, integer *il, integer *i --d__; /* Function Body */ *info = 0; + wend = 0; + mb = 0; + irange = 0; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/slarrf.c b/src/map/lapack2flamec/f2c/c/slarrf.c index a6785985b..05d093140 100644 --- a/src/map/lapack2flamec/f2c/c/slarrf.c +++ b/src/map/lapack2flamec/f2c/c/slarrf.c @@ -235,6 +235,7 @@ int slarrf_(integer *n, real *d__, real *l, real *ld, integer *clstrt, integer * --d__; /* Function Body */ *info = 0; + indx = 0; /* Quick return if possible */ if (*n <= 0) { diff --git a/src/map/lapack2flamec/f2c/c/slarrv.c b/src/map/lapack2flamec/f2c/c/slarrv.c index a857fe03a..9547b0d8c 100644 --- a/src/map/lapack2flamec/f2c/c/slarrv.c +++ b/src/map/lapack2flamec/f2c/c/slarrv.c @@ -299,7 +299,6 @@ int slarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i real ztz; integer iend, jblk; real lgap; - integer done; real rgap, left; integer wend, iter; real bstw; @@ -459,8 +458,6 @@ int slarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i /* entries is contained in the interval IBEGIN:IEND. */ /* Remark that if k eigenpairs are desired, then the eigenvectors */ /* are stored in k contiguous columns of Z. */ - /* DONE is the number of eigenvectors already computed */ - done = 0; ibegin = 1; wbegin = 1; i__1 = iblock[*m]; @@ -519,7 +516,6 @@ int slarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i /* This is for a 1x1 block */ if (ibegin == iend) { - ++done; z__[ibegin + wbegin * z_dim1] = 1.f; isuppz[(wbegin << 1) - 1] = ibegin; isuppz[wbegin * 2] = ibegin; @@ -861,7 +857,6 @@ int slarrv_(integer *n, real *vl, real *vu, real *d__, real * l, real *pivmin, i i__4 = windex + 1; windpl = fla_min(i__4,*m); lambda = work[windex]; - ++done; /* Check if eigenvector computation is to be skipped */ if (windex < *dol || windex > *dou) { diff --git a/src/map/lapack2flamec/f2c/c/slartg.c b/src/map/lapack2flamec/f2c/c/slartg.c index d0e9350cf..778f482a9 100644 --- a/src/map/lapack2flamec/f2c/c/slartg.c +++ b/src/map/lapack2flamec/f2c/c/slartg.c @@ -1,6 +1,100 @@ /* slartg.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +/* > \brief \b SLARTG generates a plane rotation with real cosine and real sine. */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE SLARTG( F, G, C, S, R ) */ +/* .. Scalar Arguments .. */ +/* REAL(wp) C, F, G, R, S */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > SLARTG generates a plane rotation so that */ +/* > */ +/* > [ C S ] . [ F ] = [ R ] */ +/* > [ -S C ] [ G ] [ 0 ] */ +/* > */ +/* > where C**2 + S**2 = 1. */ +/* > */ +/* > The mathematical formulas used for C and S are */ +/* > R = sign(F) * sqrt(F**2 + G**2) */ +/* > C = F / R */ +/* > S = G / R */ +/* > Hence C >= 0. The algorithm used to compute these quantities */ +/* > incorporates scaling to avoid overflow or underflow in computing the */ +/* > square root of the sum of squares. */ +/* > */ +/* > This version is discontinuous in R at F = 0 but it returns the same */ +/* > C and S as CLARTG for complex inputs (F,0) and (G,0). */ +/* > */ +/* > This is a more accurate version of the BLAS1 routine SROTG, */ +/* > with the following other differences: */ +/* > F and G are unchanged on return. */ +/* > If G=0, then C=1 and S=0. */ +/* > If F=0 and (G .ne. 0), then C=0 and S=sign(1,G) without doing any */ +/* > floating point operations (saves work in SBDSQR when */ +/* > there are zeros on the diagonal). */ +/* > */ +/* > Below, wp=>sp stands for single precision from LA_CONSTANTS module. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] F */ +/* > \verbatim */ +/* > F is REAL(wp) */ +/* > The first component of vector to be rotated. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] G */ +/* > \verbatim */ +/* > G is REAL(wp) */ +/* > The second component of vector to be rotated. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] C */ +/* > \verbatim */ +/* > C is REAL(wp) */ +/* > The cosine of the rotation. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] S */ +/* > \verbatim */ +/* > S is REAL(wp) */ +/* > The sine of the rotation. */ +/* > \endverbatim */ +/* > */ +/* > \param[out] R */ +/* > \verbatim */ +/* > R is REAL(wp) */ +/* > The nonzero component of the rotated vector. */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Edward Anderson, Lockheed Martin */ +/* > \date July 2016 */ +/* > \ingroup OTHERauxiliary */ +/* > \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 */ +/* > */ +/* > \endverbatim */ static real c_b2 = 1.f; /* Subroutine */ int slartg_(real *f, real *g, real *c__, real *s, real *r__) @@ -13,12 +107,10 @@ int slartg_(real *f, real *g, real *c__, real *s, real *r__) /* Local variables */ real d__, u, f1, g1, fs, gs, rtmin, rtmax, safmin, safmax; /* ...Translated by Pacific-Sierra Research vf90 Personal 3.4N3 05:33:20 1/24/23 */ - /* ...Switches: */ - /* .. */ - /* .. Local Scalars .. */ - /* .. */ - /* .. Intrinsic Functions .. */ - /* .. */ + /* -- LAPACK auxiliary routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* February 2021 */ /* .. Constants .. */ safmin = 1.1754943508222875e-38f; safmax = 8.5070591730234616e37f; diff --git a/src/map/lapack2flamec/f2c/c/slaruv.c b/src/map/lapack2flamec/f2c/c/slaruv.c index 63d2fcb13..113cb1ed4 100644 --- a/src/map/lapack2flamec/f2c/c/slaruv.c +++ b/src/map/lapack2flamec/f2c/c/slaruv.c @@ -130,6 +130,10 @@ int slaruv_(integer *iseed, integer *n, real *x) i3 = iseed[3]; i4 = iseed[4]; i__1 = fla_min(*n,128); + it1 = 0; + it2 = 0; + it3 = 0; + it4 = 0; for (i__ = 1; i__ <= i__1; ++i__) diff --git a/src/map/lapack2flamec/f2c/c/slarzb.c b/src/map/lapack2flamec/f2c/c/slarzb.c index cf11fbd60..caab31aad 100644 --- a/src/map/lapack2flamec/f2c/c/slarzb.c +++ b/src/map/lapack2flamec/f2c/c/slarzb.c @@ -188,7 +188,7 @@ int slarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in integer i__, j, info; extern logical lsame_(char *, char *); extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); char transt[1]; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -241,7 +241,7 @@ int slarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in if (info != 0) { i__1 = -info; - xerbla_("SLARZB", &i__1); + xerbla_("SLARZB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slarzt.c b/src/map/lapack2flamec/f2c/c/slarzt.c index c02250440..3489cb10c 100644 --- a/src/map/lapack2flamec/f2c/c/slarzt.c +++ b/src/map/lapack2flamec/f2c/c/slarzt.c @@ -192,7 +192,7 @@ int slarzt_(char *direct, char *storev, integer *n, integer * k, real *v, intege integer i__, j, info; extern logical lsame_(char *, char *); extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_( char *, integer *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -233,7 +233,7 @@ int slarzt_(char *direct, char *storev, integer *n, integer * k, real *v, intege if (info != 0) { i__1 = -info; - xerbla_("SLARZT", &i__1); + xerbla_("SLARZT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slascl.c b/src/map/lapack2flamec/f2c/c/slascl.c index 01afeffde..395411ede 100644 --- a/src/map/lapack2flamec/f2c/c/slascl.c +++ b/src/map/lapack2flamec/f2c/c/slascl.c @@ -148,7 +148,7 @@ int slascl_(char *type__, integer *kl, integer *ku, real * cfrom, real *cto, int extern real slamch_(char *); real cfromc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern logical sisnan_(real *); real smlnum; @@ -259,7 +259,7 @@ int slascl_(char *type__, integer *kl, integer *ku, real * cfrom, real *cto, int if (*info != 0) { i__1 = -(*info); - xerbla_("SLASCL", &i__1); + xerbla_("SLASCL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasd0.c b/src/map/lapack2flamec/f2c/c/slasd0.c index ed421ac65..2cd8b7361 100644 --- a/src/map/lapack2flamec/f2c/c/slasd0.c +++ b/src/map/lapack2flamec/f2c/c/slasd0.c @@ -153,7 +153,7 @@ int slasd0_(integer *n, integer *sqre, real *d__, real *e, real *u, integer *ldu real alpha; integer inode, ndiml, idxqc, ndimr, itemp, sqrei; extern /* Subroutine */ - int slasd1_(integer *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *), xerbla_(char *, integer *), slasdq_(char *, integer *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer * ); + int slasd1_(integer *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slasdq_(char *, integer *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer * ); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -206,7 +206,7 @@ int slasd0_(integer *n, integer *sqre, real *d__, real *e, real *u, integer *ldu if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD0", &i__1); + xerbla_("SLASD0", &i__1, (ftnlen)6); return 0; } /* If the input matrix is too small, call SLASDQ to find the SVD. */ diff --git a/src/map/lapack2flamec/f2c/c/slasd1.c b/src/map/lapack2flamec/f2c/c/slasd1.c index f7f846b34..1c3a47878 100644 --- a/src/map/lapack2flamec/f2c/c/slasd1.c +++ b/src/map/lapack2flamec/f2c/c/slasd1.c @@ -209,7 +209,7 @@ int slasd1_(integer *nl, integer *nr, integer *sqre, real * d__, real *alpha, re int slasd2_(integer *, integer *, integer *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *, integer *, integer *, integer *, integer *, integer *), slasd3_(integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *); integer isigma; extern /* Subroutine */ - int xerbla_(char *, integer *), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); real orgnrm; integer coltyp; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ @@ -259,7 +259,7 @@ int slasd1_(integer *nl, integer *nr, integer *sqre, real * d__, real *alpha, re if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD1", &i__1); + xerbla_("SLASD1", &i__1, (ftnlen)6); return 0; } n = *nl + *nr + 1; diff --git a/src/map/lapack2flamec/f2c/c/slasd2.c b/src/map/lapack2flamec/f2c/c/slasd2.c index ea0ba73b7..e12b7a6ae 100644 --- a/src/map/lapack2flamec/f2c/c/slasd2.c +++ b/src/map/lapack2flamec/f2c/c/slasd2.c @@ -283,7 +283,7 @@ int slasd2_(integer *nl, integer *nr, integer *sqre, integer *k, real *d__, real int scopy_(integer *, real *, integer *, real *, integer *); extern real slapy2_(real *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); real hlftol; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -333,6 +333,7 @@ int slasd2_(integer *nl, integer *nr, integer *sqre, integer *k, real *d__, real --coltyp; /* Function Body */ *info = 0; + jprev = 0; if (*nl < 1) { *info = -1; @@ -366,7 +367,7 @@ int slasd2_(integer *nl, integer *nr, integer *sqre, integer *k, real *d__, real if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD2", &i__1); + xerbla_("SLASD2", &i__1, (ftnlen)6); return 0; } nlp1 = *nl + 1; diff --git a/src/map/lapack2flamec/f2c/c/slasd3.c b/src/map/lapack2flamec/f2c/c/slasd3.c index 21f2e97ef..401aef07f 100644 --- a/src/map/lapack2flamec/f2c/c/slasd3.c +++ b/src/map/lapack2flamec/f2c/c/slasd3.c @@ -237,7 +237,7 @@ int slasd3_(integer *nl, integer *nr, integer *sqre, integer *k, real *d__, real int scopy_(integer *, real *, integer *, real *, integer *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int slasd4_(integer *, integer *, real *, real *, real *, real *, real *, real *, integer *), xerbla_(char *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); + int slasd4_(integer *, integer *, real *, real *, real *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -325,7 +325,7 @@ int slasd3_(integer *nl, integer *nr, integer *sqre, integer *k, real *d__, real if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD3", &i__1); + xerbla_("SLASD3", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slasd6.c b/src/map/lapack2flamec/f2c/c/slasd6.c index 37516fdd6..40deedee3 100644 --- a/src/map/lapack2flamec/f2c/c/slasd6.c +++ b/src/map/lapack2flamec/f2c/c/slasd6.c @@ -321,7 +321,7 @@ int slasd6_(integer *icompq, integer *nl, integer *nr, integer *sqre, real *d__, int scopy_(integer *, real *, integer *, real *, integer *), slasd7_(integer *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slasd8_(integer *, integer *, real *, real *, real *, real *, real *, real *, integer *, real *, real *, integer *); integer isigma; extern /* Subroutine */ - int xerbla_(char *, integer *), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); real orgnrm; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -393,7 +393,7 @@ int slasd6_(integer *icompq, integer *nl, integer *nr, integer *sqre, real *d__, if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD6", &i__1); + xerbla_("SLASD6", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasd7.c b/src/map/lapack2flamec/f2c/c/slasd7.c index e5d461941..52f8085a7 100644 --- a/src/map/lapack2flamec/f2c/c/slasd7.c +++ b/src/map/lapack2flamec/f2c/c/slasd7.c @@ -292,7 +292,7 @@ int slasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k int scopy_(integer *, real *, integer *, real *, integer *); extern real slapy2_(real *, real *), slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slamrg_( integer *, integer *, real *, integer *, integer *, integer *); real hlftol; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -338,6 +338,7 @@ int slasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k *info = 0; n = *nl + *nr + 1; m = n + *sqre; + jprev = 0; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -365,7 +366,7 @@ int slasd7_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *k if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD7", &i__1); + xerbla_("SLASD7", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasd8.c b/src/map/lapack2flamec/f2c/c/slasd8.c index 736fef3a5..7b64f8fad 100644 --- a/src/map/lapack2flamec/f2c/c/slasd8.c +++ b/src/map/lapack2flamec/f2c/c/slasd8.c @@ -181,7 +181,7 @@ int slasd8_(integer *icompq, integer *k, real *d__, real * z__, real *vf, real * int scopy_(integer *, real *, integer *, real *, integer *); extern real slamc3_(real *, real *); extern /* Subroutine */ - int slasd4_(integer *, integer *, real *, real *, real *, real *, real *, real *, integer *), xerbla_(char *, integer *); + int slasd4_(integer *, integer *, real *, real *, real *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real dsigjp; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -219,6 +219,7 @@ int slasd8_(integer *icompq, integer *k, real *d__, real * z__, real *vf, real * --work; /* Function Body */ *info = 0; + difrj = 0.f; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -234,7 +235,7 @@ int slasd8_(integer *icompq, integer *k, real *d__, real * z__, real *vf, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SLASD8", &i__1); + xerbla_("SLASD8", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasda.c b/src/map/lapack2flamec/f2c/c/slasda.c index 317f47d14..1f49ea080 100644 --- a/src/map/lapack2flamec/f2c/c/slasda.c +++ b/src/map/lapack2flamec/f2c/c/slasda.c @@ -286,7 +286,7 @@ int slasda_(integer *icompq, integer *smlsiz, integer *n, integer *sqre, real *d int scopy_(integer *, real *, integer *, real *, integer *), slasd6_(integer *, integer *, integer *, integer *, real *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *, integer *); integer nwork1, nwork2; extern /* Subroutine */ - int xerbla_(char *, integer *), slasdq_( char *, integer *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slasdq_( char *, integer *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), slasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); integer smlszp; /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -370,7 +370,7 @@ int slasda_(integer *icompq, integer *smlsiz, integer *n, integer *sqre, real *d if (*info != 0) { i__1 = -(*info); - xerbla_("SLASDA", &i__1); + xerbla_("SLASDA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasdq.c b/src/map/lapack2flamec/f2c/c/slasdq.c index 4091786a7..8235b757d 100644 --- a/src/map/lapack2flamec/f2c/c/slasdq.c +++ b/src/map/lapack2flamec/f2c/c/slasdq.c @@ -219,7 +219,7 @@ int slasdq_(char *uplo, integer *sqre, integer *n, integer * ncvt, integer *nru, int slasr_(char *, char *, char *, integer *, integer *, real *, real *, real *, integer *); integer iuplo; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slartg_(real *, real *, real *, real *, real *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slartg_(real *, real *, real *, real *, real *); logical rotate; extern /* Subroutine */ int sbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -307,7 +307,7 @@ int slasdq_(char *uplo, integer *sqre, integer *n, integer * ncvt, integer *nru, if (*info != 0) { i__1 = -(*info); - xerbla_("SLASDQ", &i__1); + xerbla_("SLASDQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasq1.c b/src/map/lapack2flamec/f2c/c/slasq1.c index ab46fae36..2468c5e0a 100644 --- a/src/map/lapack2flamec/f2c/c/slasq1.c +++ b/src/map/lapack2flamec/f2c/c/slasq1.c @@ -124,7 +124,7 @@ int slasq1_(integer *n, real *d__, real *e, real *work, integer *info) extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slasrt_(char *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slascl_( char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), slasrt_(char *, integer *, real *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -155,7 +155,7 @@ int slasq1_(integer *n, real *d__, real *e, real *work, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("SLASQ1", &i__1); + xerbla_("SLASQ1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasq2.c b/src/map/lapack2flamec/f2c/c/slasq2.c index 994c9eae9..bd2603f68 100644 --- a/src/map/lapack2flamec/f2c/c/slasq2.c +++ b/src/map/lapack2flamec/f2c/c/slasq2.c @@ -138,7 +138,7 @@ int slasq2_(integer *n, real *z__, integer *info) integer iwhila, iwhilb; real oldemn, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), slasrt_( char *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slasrt_( char *, integer *, real *, integer *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -173,7 +173,7 @@ int slasq2_(integer *n, real *z__, integer *info) if (*n < 0) { *info = -1; - xerbla_("SLASQ2", &c__1); + xerbla_("SLASQ2", &c__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -188,7 +188,7 @@ int slasq2_(integer *n, real *z__, integer *info) if (z__[1] < 0.f) { *info = -201; - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); } AOCL_DTL_TRACE_LOG_EXIT return 0; @@ -199,21 +199,21 @@ int slasq2_(integer *n, real *z__, integer *info) if (z__[1] < 0.f) { *info = -201; - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[2] < 0.f) { *info = -202; - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[3] < 0.f) { *info = -203; - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -260,14 +260,14 @@ int slasq2_(integer *n, real *z__, integer *info) if (z__[k] < 0.f) { *info = -(k + 200); - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (z__[k + 1] < 0.f) { *info = -(k + 201); - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -290,7 +290,7 @@ int slasq2_(integer *n, real *z__, integer *info) if (z__[(*n << 1) - 1] < 0.f) { *info = -((*n << 1) + 199); - xerbla_("SLASQ2", &c__2); + xerbla_("SLASQ2", &c__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasq4.c b/src/map/lapack2flamec/f2c/c/slasq4.c index 59b6863b2..619a3304a 100644 --- a/src/map/lapack2flamec/f2c/c/slasq4.c +++ b/src/map/lapack2flamec/f2c/c/slasq4.c @@ -174,6 +174,7 @@ int slasq4_(integer *i0, integer *n0, real *z__, integer *pp, integer *n0in, rea /* Parameter adjustments */ --z__; /* Function Body */ + s = 0.f; if (*dmin__ <= 0.f) { *tau = -(*dmin__); diff --git a/src/map/lapack2flamec/f2c/c/slasr.c b/src/map/lapack2flamec/f2c/c/slasr.c index fc9315277..a756e7835 100644 --- a/src/map/lapack2flamec/f2c/c/slasr.c +++ b/src/map/lapack2flamec/f2c/c/slasr.c @@ -201,7 +201,7 @@ int slasr_(char *side, char *pivot, char *direct, integer *m, integer *n, real * extern logical lsame_(char *, char *); real ctemp, stemp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -257,7 +257,7 @@ int slasr_(char *side, char *pivot, char *direct, integer *m, integer *n, real * } if (info != 0) { - xerbla_("SLASR ", &info); + xerbla_("SLASR ", &info, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasrt.c b/src/map/lapack2flamec/f2c/c/slasrt.c index 493c1ee20..0db6598f7 100644 --- a/src/map/lapack2flamec/f2c/c/slasrt.c +++ b/src/map/lapack2flamec/f2c/c/slasrt.c @@ -97,7 +97,7 @@ int slasrt_(char *id, integer *n, real *d__, integer *info) real dmnmx; integer start; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer stkpnt; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -144,7 +144,7 @@ int slasrt_(char *id, integer *n, real *d__, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SLASRT", &i__1); + xerbla_("SLASRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slassq.c b/src/map/lapack2flamec/f2c/c/slassq.c index 1f5ed622c..b3a116d65 100644 --- a/src/map/lapack2flamec/f2c/c/slassq.c +++ b/src/map/lapack2flamec/f2c/c/slassq.c @@ -94,7 +94,7 @@ int slassq_(integer *n, real *x, integer *incx, real *scl, real *sumsq) AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("slassq inputs: n %" FLA_IS ", incx %" FLA_IS "",*n, *incx); /* System generated locals */ - integer i__1, i__2; + integer i__1; real r__1, r__2; /* Builtin functions */ double pow_ri(real *, real *), sqrt(doublereal); diff --git a/src/map/lapack2flamec/f2c/c/slaswlq.c b/src/map/lapack2flamec/f2c/c/slaswlq.c index e18f7e6dc..4055a1c9c 100644 --- a/src/map/lapack2flamec/f2c/c/slaswlq.c +++ b/src/map/lapack2flamec/f2c/c/slaswlq.c @@ -166,7 +166,7 @@ int slaswlq_(integer *m, integer *n, integer *mb, integer * nb, real *a, integer /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), sgelqt_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgelqt_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); logical lquery; extern /* Subroutine */ int stplqt_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -233,7 +233,7 @@ int slaswlq_(integer *m, integer *n, integer *mb, integer * nb, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SLASWLQ", &i__1); + xerbla_("SLASWLQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slasy2.c b/src/map/lapack2flamec/f2c/c/slasy2.c index 0dfcd49f7..984d3c878 100644 --- a/src/map/lapack2flamec/f2c/c/slasy2.c +++ b/src/map/lapack2flamec/f2c/c/slasy2.c @@ -208,10 +208,10 @@ int slasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, intege integer ipsv, jpsv; logical bswap; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ); + int scopy_(const integer *, real *, const integer *, real *, const integer *), sswap_(const integer *, real *, const integer *, real *, const integer * ); logical xswap; extern real slamch_(char *); - extern integer isamax_(integer *, real *, integer *); + extern integer isamax_(const integer *, real *, const integer *); real smlnum; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -253,6 +253,8 @@ int slasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, intege /* .. Executable Statements .. */ /* Do not check the input parameters for errors */ *info = 0; + jpsv = 0; + ipsv = 0; /* Quick return if possible */ if (*n1 == 0 || *n2 == 0) { diff --git a/src/map/lapack2flamec/f2c/c/slasyf_rk.c b/src/map/lapack2flamec/f2c/c/slasyf_rk.c index 9cbcfc376..7083a3f0c 100644 --- a/src/map/lapack2flamec/f2c/c/slasyf_rk.c +++ b/src/map/lapack2flamec/f2c/c/slasyf_rk.c @@ -313,6 +313,7 @@ int slasyf_rk_(char *uplo, integer *n, integer *nb, integer *kb, real *a, intege w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/slasyf_rook.c b/src/map/lapack2flamec/f2c/c/slasyf_rook.c index d6e2be6c8..acefea9da 100644 --- a/src/map/lapack2flamec/f2c/c/slasyf_rook.c +++ b/src/map/lapack2flamec/f2c/c/slasyf_rook.c @@ -235,6 +235,7 @@ int slasyf_rook_(char *uplo, integer *n, integer *nb, integer *kb, real *a, inte alpha = (sqrt(17.f) + 1.f) / 8.f; /* Compute machine safe minimum */ sfmin = slamch_("S"); + jmax = 0; if (lsame_(uplo, "U")) { /* Factorize the trailing columns of A using the upper triangle */ diff --git a/src/map/lapack2flamec/f2c/c/slatbs.c b/src/map/lapack2flamec/f2c/c/slatbs.c index 7fa9a7da8..7c7f7a328 100644 --- a/src/map/lapack2flamec/f2c/c/slatbs.c +++ b/src/map/lapack2flamec/f2c/c/slatbs.c @@ -262,7 +262,7 @@ int slatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte int stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); logical notran; @@ -300,6 +300,7 @@ int slatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.f; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -332,7 +333,7 @@ int slatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte if (*info != 0) { i__1 = -(*info); - xerbla_("SLATBS", &i__1); + xerbla_("SLATBS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slatps.c b/src/map/lapack2flamec/f2c/c/slatps.c index 9cab8aa39..c297d2f98 100644 --- a/src/map/lapack2flamec/f2c/c/slatps.c +++ b/src/map/lapack2flamec/f2c/c/slatps.c @@ -248,7 +248,7 @@ int slatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, real int saxpy_(integer *, real *, real *, integer *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); logical notran; @@ -284,6 +284,7 @@ int slatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, real upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.f; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -308,7 +309,7 @@ int slatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, real if (*info != 0) { i__1 = -(*info); - xerbla_("SLATPS", &i__1); + xerbla_("SLATPS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slatrs.c b/src/map/lapack2flamec/f2c/c/slatrs.c index c1b163ef9..9dacc8a61 100644 --- a/src/map/lapack2flamec/f2c/c/slatrs.c +++ b/src/map/lapack2flamec/f2c/c/slatrs.c @@ -255,7 +255,7 @@ int slatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, real int saxpy_(integer *, real *, real *, integer *, real *, integer *), strsv_(char *, char *, char *, integer *, real *, integer *, real *, integer *); extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); logical notran; @@ -292,6 +292,7 @@ int slatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, real upper = lsame_(uplo, "U"); notran = lsame_(trans, "N"); nounit = lsame_(diag, "N"); + tjjs = 0.f; /* Test the input parameters. */ if (! upper && ! lsame_(uplo, "L")) { @@ -320,7 +321,7 @@ int slatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, real if (*info != 0) { i__1 = -(*info); - xerbla_("SLATRS", &i__1); + xerbla_("SLATRS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/slatrs3.c b/src/map/lapack2flamec/f2c/c/slatrs3.c index 58af02798..e5b01c268 100644 --- a/src/map/lapack2flamec/f2c/c/slatrs3.c +++ b/src/map/lapack2flamec/f2c/c/slatrs3.c @@ -243,7 +243,7 @@ int slatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); real scamin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern real slarmm_(real *, real *, real *); @@ -361,7 +361,7 @@ int slatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int if (*info != 0) { i__1 = -(*info); - xerbla_("SLATRS3", &i__1); + xerbla_("SLATRS3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/slatsqr.c b/src/map/lapack2flamec/f2c/c/slatsqr.c index 67e508088..889a97a68 100644 --- a/src/map/lapack2flamec/f2c/c/slatsqr.c +++ b/src/map/lapack2flamec/f2c/c/slatsqr.c @@ -168,7 +168,7 @@ int slatsqr_(integer *m, integer *n, integer *mb, integer * nb, real *a, integer /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), sgeqrt_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgeqrt_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *); logical lquery; extern /* Subroutine */ int stpqrt_(integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -235,7 +235,7 @@ int slatsqr_(integer *m, integer *n, integer *mb, integer * nb, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SLATSQR", &i__1); + xerbla_("SLATSQR", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sopmtr.c b/src/map/lapack2flamec/f2c/c/sopmtr.c index 1a1e5ea9a..0626e4b9e 100644 --- a/src/map/lapack2flamec/f2c/c/sopmtr.c +++ b/src/map/lapack2flamec/f2c/c/sopmtr.c @@ -160,7 +160,7 @@ int sopmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, real *a int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int sopmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SOPMTR", &i__1); + xerbla_("SOPMTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb.c b/src/map/lapack2flamec/f2c/c/sorbdb.c index 8f3c3e025..15aef50ca 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb.c @@ -302,7 +302,7 @@ int sorbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, real * extern real snrm2_(integer *, real *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), saxpy_(integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), saxpy_(integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; extern /* Subroutine */ int slarfgp_(integer *, real *, real *, integer *, real *); @@ -447,7 +447,7 @@ int sorbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, real * if (*info != 0) { i__1 = -(*info); - xerbla_("xORBDB", &i__1); + xerbla_("xORBDB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb1.c b/src/map/lapack2flamec/f2c/c/sorbdb1.c index d22ffec9c..c756f6d3e 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb1.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb1.c @@ -214,7 +214,7 @@ int sorbdb1_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real extern real snrm2_(integer *, real *, integer *); integer ilarf, llarf; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -307,7 +307,7 @@ int sorbdb1_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB1", &i__1); + xerbla_("SORBDB1", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb2.c b/src/map/lapack2flamec/f2c/c/sorbdb2.c index a6e64231e..9b814b4ae 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb2.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb2.c @@ -213,7 +213,7 @@ int sorbdb2_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real extern real snrm2_(integer *, real *, integer *); integer ilarf, llarf; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -306,7 +306,7 @@ int sorbdb2_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB2", &i__1); + xerbla_("SORBDB2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb3.c b/src/map/lapack2flamec/f2c/c/sorbdb3.c index 2a1a47e7c..bbf703d80 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb3.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb3.c @@ -213,7 +213,7 @@ int sorbdb3_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real extern real snrm2_(integer *, real *, integer *); integer ilarf, llarf; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -306,7 +306,7 @@ int sorbdb3_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB3", &i__1); + xerbla_("SORBDB3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb4.c b/src/map/lapack2flamec/f2c/c/sorbdb4.c index 49f7e878f..df1c1648e 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb4.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb4.c @@ -226,7 +226,7 @@ int sorbdb4_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real extern real snrm2_(integer *, real *, integer *); integer ilarf, llarf; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -321,7 +321,7 @@ int sorbdb4_(integer *m, integer *p, integer *q, real *x11, integer *ldx11, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB4", &i__1); + xerbla_("SORBDB4", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb5.c b/src/map/lapack2flamec/f2c/c/sorbdb5.c index 30fdb35ff..3e28e13fb 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb5.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb5.c @@ -155,7 +155,7 @@ int sorbdb5_(integer *m1, integer *m2, integer *n, real *x1, integer *incx1, rea integer i__, j, childinfo; extern real snrm2_(integer *, real *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), sorbdb6_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sorbdb6_( integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -224,7 +224,7 @@ int sorbdb5_(integer *m1, integer *m2, integer *n, real *x1, integer *incx1, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB5", &i__1); + xerbla_("SORBDB5", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorbdb6.c b/src/map/lapack2flamec/f2c/c/sorbdb6.c index 06adcf7ae..d9a0f0356 100644 --- a/src/map/lapack2flamec/f2c/c/sorbdb6.c +++ b/src/map/lapack2flamec/f2c/c/sorbdb6.c @@ -159,7 +159,7 @@ int sorbdb6_(integer *m1, integer *m2, integer *n, real *x1, integer *incx1, rea integer i__; real scl1, scl2, ssq1, ssq2; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *), slassq_(integer *, real *, integer *, real *, real *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slassq_(integer *, real *, integer *, real *, real *); real normsq1, normsq2; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -227,7 +227,7 @@ int sorbdb6_(integer *m1, integer *m2, integer *n, real *x1, integer *incx1, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SORBDB6", &i__1); + xerbla_("SORBDB6", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorg2l.c b/src/map/lapack2flamec/f2c/c/sorg2l.c index d7d48201b..0bd619188 100644 --- a/src/map/lapack2flamec/f2c/c/sorg2l.c +++ b/src/map/lapack2flamec/f2c/c/sorg2l.c @@ -116,7 +116,7 @@ int sorg2l_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int sorg2l_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SORG2L", &i__1); + xerbla_("SORG2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorgql.c b/src/map/lapack2flamec/f2c/c/sorgql.c index eb01aa613..11cb34430 100644 --- a/src/map/lapack2flamec/f2c/c/sorgql.c +++ b/src/map/lapack2flamec/f2c/c/sorgql.c @@ -133,7 +133,7 @@ int sorgql_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau /* Local variables */ integer i__, j, l, ib, nb, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sorg2l_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorg2l_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -185,6 +185,7 @@ int sorgql_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau { *info = -5; } + nb = ilaenv_(&c__1, "SORGQL", " ", m, n, k, &c_n1); if (*info == 0) { if (*n == 0) @@ -193,7 +194,6 @@ int sorgql_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau } else { - nb = ilaenv_(&c__1, "SORGQL", " ", m, n, k, &c_n1); lwkopt = *n * nb; } work[1] = (real) lwkopt; @@ -205,7 +205,7 @@ int sorgql_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SORGQL", &i__1); + xerbla_("SORGQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorgr2.c b/src/map/lapack2flamec/f2c/c/sorgr2.c index b9186cf65..a7db8ca77 100644 --- a/src/map/lapack2flamec/f2c/c/sorgr2.c +++ b/src/map/lapack2flamec/f2c/c/sorgr2.c @@ -114,7 +114,7 @@ int sorgr2_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -161,7 +161,7 @@ int sorgr2_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SORGR2", &i__1); + xerbla_("SORGR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorgrq.c b/src/map/lapack2flamec/f2c/c/sorgrq.c index fc28057a7..33febde36 100644 --- a/src/map/lapack2flamec/f2c/c/sorgrq.c +++ b/src/map/lapack2flamec/f2c/c/sorgrq.c @@ -133,7 +133,7 @@ int sorgrq_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau /* Local variables */ integer i__, j, l, ib, nb, ii, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sorgr2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorgr2_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -185,6 +185,7 @@ int sorgrq_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau { *info = -5; } + nb = ilaenv_(&c__1, "SORGRQ", " ", m, n, k, &c_n1); if (*info == 0) { if (*m <= 0) @@ -193,7 +194,6 @@ int sorgrq_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau } else { - nb = ilaenv_(&c__1, "SORGRQ", " ", m, n, k, &c_n1); lwkopt = *m * nb; } work[1] = (real) lwkopt; @@ -205,7 +205,7 @@ int sorgrq_(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau if (*info != 0) { i__1 = -(*info); - xerbla_("SORGRQ", &i__1); + xerbla_("SORGRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorgtsqr.c b/src/map/lapack2flamec/f2c/c/sorgtsqr.c index 9c47433f3..be29bcc17 100644 --- a/src/map/lapack2flamec/f2c/c/sorgtsqr.c +++ b/src/map/lapack2flamec/f2c/c/sorgtsqr.c @@ -180,7 +180,7 @@ int sorgtsqr_(integer *m, integer *n, integer *mb, integer * nb, real *a, intege int slamtsqr_(char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); integer lworkopt, j, lc, lw, ldc, iinfo; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); logical lquery; integer nblocal; /* -- LAPACK computational routine (version 3.9.0) -- */ @@ -273,7 +273,7 @@ int sorgtsqr_(integer *m, integer *n, integer *mb, integer * nb, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SORGTSQR", &i__1); + xerbla_("SORGTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorgtsqr_row.c b/src/map/lapack2flamec/f2c/c/sorgtsqr_row.c index 744ea7fdf..c1ae62a29 100644 --- a/src/map/lapack2flamec/f2c/c/sorgtsqr_row.c +++ b/src/map/lapack2flamec/f2c/c/sorgtsqr_row.c @@ -191,7 +191,7 @@ int sorgtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, real *a, int real dummy[1] /* was [1][1] */ ; extern /* Subroutine */ - int xerbla_(char *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_( char *, integer *, integer *, real *, real *, real *, integer *); logical lquery; integer nblocal, kb_last__; /* -- LAPACK computational routine -- */ @@ -272,7 +272,7 @@ int sorgtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, real *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("SORGTSQR_ROW", &i__1); + xerbla_("SORGTSQR_ROW", &i__1, (ftnlen)12); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sorhr_col.c b/src/map/lapack2flamec/f2c/c/sorhr_col.c index 0081f8ae4..741b8cab2 100644 --- a/src/map/lapack2flamec/f2c/c/sorhr_col.c +++ b/src/map/lapack2flamec/f2c/c/sorhr_col.c @@ -276,7 +276,7 @@ int sorhr_col_(integer *m, integer *n, integer *nb, real *a, integer *lda, real int slaorhr_col_getrfnp_(integer *, integer *, real *, integer *, real *, integer *); integer iinfo; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), strsm_( char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), strsm_( char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jbtemp1, jbtemp2; /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -337,7 +337,7 @@ int sorhr_col_(integer *m, integer *n, integer *nb, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORHR_COL", &i__1); + xerbla_("SORHR_COL", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sorm22.c b/src/map/lapack2flamec/f2c/c/sorm22.c index 1d80bef65..0f55da034 100644 --- a/src/map/lapack2flamec/f2c/c/sorm22.c +++ b/src/map/lapack2flamec/f2c/c/sorm22.c @@ -164,7 +164,7 @@ int sorm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); logical notran; integer ldwork, lwkopt; logical lquery; @@ -261,7 +261,7 @@ int sorm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SORM22", &i__1); + xerbla_("SORM22", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/sorm2l.c b/src/map/lapack2flamec/f2c/c/sorm2l.c index 581fd0e1e..9e116881a 100644 --- a/src/map/lapack2flamec/f2c/c/sorm2l.c +++ b/src/map/lapack2flamec/f2c/c/sorm2l.c @@ -164,7 +164,7 @@ int sorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, real *a logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int sorm2l_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SORM2L", &i__1); + xerbla_("SORM2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sormql.c b/src/map/lapack2flamec/f2c/c/sormql.c index 352870558..202142d44 100644 --- a/src/map/lapack2flamec/f2c/c/sormql.c +++ b/src/map/lapack2flamec/f2c/c/sormql.c @@ -173,8 +173,7 @@ int sormql_(char *side, char *trans, integer *m, integer *n, integer *k, real *a AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -185,7 +184,7 @@ int sormql_(char *side, char *trans, integer *m, integer *n, integer *k, real *a extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int sorm2l_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorm2l_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -270,6 +269,9 @@ int sormql_(char *side, char *trans, integer *m, integer *n, integer *k, real *a { *info = -12; } + i__1 = 64; + i__2 = ilaenv_(&c__1, "SORMQL", ch__1, m, n, k, &c_n1); // , expr subst + nb = fla_min(i__1,i__2); if (*info == 0) { /* Compute the workspace requirements */ @@ -280,9 +282,6 @@ int sormql_(char *side, char *trans, integer *m, integer *n, integer *k, real *a else { /* Computing MIN */ - i__1 = 64; - i__2 = ilaenv_(&c__1, "SORMQL", ch__1, m, n, k, &c_n1); // , expr subst - nb = fla_min(i__1,i__2); lwkopt = nw * nb + 4160; } work[1] = (real) lwkopt; @@ -290,7 +289,7 @@ int sormql_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SORMQL", &i__1); + xerbla_("SORMQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sormr2.c b/src/map/lapack2flamec/f2c/c/sormr2.c index 5d32c1c8b..7181a8ff0 100644 --- a/src/map/lapack2flamec/f2c/c/sormr2.c +++ b/src/map/lapack2flamec/f2c/c/sormr2.c @@ -161,7 +161,7 @@ int sormr2_(char *side, char *trans, integer *m, integer *n, integer *k, real *a logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -237,7 +237,7 @@ int sormr2_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SORMR2", &i__1); + xerbla_("SORMR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sormr3.c b/src/map/lapack2flamec/f2c/c/sormr3.c index df3d84778..44d0b58ae 100644 --- a/src/map/lapack2flamec/f2c/c/sormr3.c +++ b/src/map/lapack2flamec/f2c/c/sormr3.c @@ -178,7 +178,7 @@ int sormr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int slarz_(char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int slarz_(char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -256,7 +256,7 @@ int sormr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SORMR3", &i__1); + xerbla_("SORMR3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sormrq.c b/src/map/lapack2flamec/f2c/c/sormrq.c index 8346ef96c..76077fa5b 100644 --- a/src/map/lapack2flamec/f2c/c/sormrq.c +++ b/src/map/lapack2flamec/f2c/c/sormrq.c @@ -172,8 +172,7 @@ int sormrq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -184,7 +183,7 @@ int sormrq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sormr2_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -271,6 +270,9 @@ int sormrq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a { *info = -12; } + i__1 = 64; + i__2 = ilaenv_(&c__1, "SORMRQ", ch__1, m, n, k, &c_n1); // , expr subst + nb = fla_min(i__1,i__2); if (*info == 0) { /* Compute the workspace requirements */ @@ -281,9 +283,6 @@ int sormrq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a else { /* Computing MIN */ - i__1 = 64; - i__2 = ilaenv_(&c__1, "SORMRQ", ch__1, m, n, k, &c_n1); // , expr subst - nb = fla_min(i__1,i__2); lwkopt = nw * nb + 4160; } work[1] = (real) lwkopt; @@ -291,7 +290,7 @@ int sormrq_(char *side, char *trans, integer *m, integer *n, integer *k, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SORMRQ", &i__1); + xerbla_("SORMRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sormrz.c b/src/map/lapack2flamec/f2c/c/sormrz.c index 96cca10e3..c1488b269 100644 --- a/src/map/lapack2flamec/f2c/c/sormrz.c +++ b/src/map/lapack2flamec/f2c/c/sormrz.c @@ -185,8 +185,7 @@ int sormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("sormrz inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", l %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS "",*side, *trans, *m, *n, *k, *l, *lda, *ldc); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -197,7 +196,7 @@ int sormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int sormr3_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sormr3_(char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarzb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -242,6 +241,7 @@ int sormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; + nb = 0; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { @@ -309,7 +309,7 @@ int sormrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SORMRZ", &i__1); + xerbla_("SORMRZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbcon.c b/src/map/lapack2flamec/f2c/c/spbcon.c index 0b1c429e9..266af87e7 100644 --- a/src/map/lapack2flamec/f2c/c/spbcon.c +++ b/src/map/lapack2flamec/f2c/c/spbcon.c @@ -146,7 +146,7 @@ int spbcon_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, real * extern real slamch_(char *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; extern /* Subroutine */ @@ -208,7 +208,7 @@ int spbcon_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SPBCON", &i__1); + xerbla_("SPBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbequ.c b/src/map/lapack2flamec/f2c/c/spbequ.c index 9d485a985..b46d6071e 100644 --- a/src/map/lapack2flamec/f2c/c/spbequ.c +++ b/src/map/lapack2flamec/f2c/c/spbequ.c @@ -136,7 +136,7 @@ int spbequ_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, real * extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -185,7 +185,7 @@ int spbequ_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SPBEQU", &i__1); + xerbla_("SPBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbrfs.c b/src/map/lapack2flamec/f2c/c/spbrfs.c index 7cf957172..66e5357a5 100644 --- a/src/map/lapack2flamec/f2c/c/spbrfs.c +++ b/src/map/lapack2flamec/f2c/c/spbrfs.c @@ -207,7 +207,7 @@ int spbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, integ extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int spbtrs_(char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -289,7 +289,7 @@ int spbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SPBRFS", &i__1); + xerbla_("SPBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbstf.c b/src/map/lapack2flamec/f2c/c/spbstf.c index 0e1990509..eb5ddde3d 100644 --- a/src/map/lapack2flamec/f2c/c/spbstf.c +++ b/src/map/lapack2flamec/f2c/c/spbstf.c @@ -168,7 +168,7 @@ int spbstf_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -216,7 +216,7 @@ int spbstf_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SPBSTF", &i__1); + xerbla_("SPBSTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbsv.c b/src/map/lapack2flamec/f2c/c/spbsv.c index 3cc168d1f..e6eaff776 100644 --- a/src/map/lapack2flamec/f2c/c/spbsv.c +++ b/src/map/lapack2flamec/f2c/c/spbsv.c @@ -165,7 +165,7 @@ int spbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, intege /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), spbtrf_( char *, integer *, integer *, real *, integer *, integer *), spbtrs_(char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spbtrf_( char *, integer *, integer *, real *, integer *, integer *), spbtrs_(char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -219,7 +219,7 @@ int spbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SPBSV ", &i__1); + xerbla_("SPBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbsvx.c b/src/map/lapack2flamec/f2c/c/spbsvx.c index 78d5dadf8..bdac5982c 100644 --- a/src/map/lapack2flamec/f2c/c/spbsvx.c +++ b/src/map/lapack2flamec/f2c/c/spbsvx.c @@ -356,7 +356,7 @@ int spbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, real extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -410,6 +410,8 @@ int spbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, real nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); upper = lsame_(uplo, "U"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -503,7 +505,7 @@ int spbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, real if (*info != 0) { i__1 = -(*info); - xerbla_("SPBSVX", &i__1); + xerbla_("SPBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbtf2.c b/src/map/lapack2flamec/f2c/c/spbtf2.c index c183e7570..c152477ce 100644 --- a/src/map/lapack2flamec/f2c/c/spbtf2.c +++ b/src/map/lapack2flamec/f2c/c/spbtf2.c @@ -156,7 +156,7 @@ int spbtf2_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -204,7 +204,7 @@ int spbtf2_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SPBTF2", &i__1); + xerbla_("SPBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbtrf.c b/src/map/lapack2flamec/f2c/c/spbtrf.c index 1ae022e01..a5b4910a3 100644 --- a/src/map/lapack2flamec/f2c/c/spbtrf.c +++ b/src/map/lapack2flamec/f2c/c/spbtrf.c @@ -150,7 +150,7 @@ int spbtrf_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege ; extern logical lsame_(char *, char *); extern /* Subroutine */ - int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer *), spbtf2_(char *, integer *, integer *, real *, integer *, integer *), spotf2_(char *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer *), spbtf2_(char *, integer *, integer *, real *, integer *, integer *), spotf2_(char *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -200,7 +200,7 @@ int spbtrf_(char *uplo, integer *n, integer *kd, real *ab, integer *ldab, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SPBTRF", &i__1); + xerbla_("SPBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spbtrs.c b/src/map/lapack2flamec/f2c/c/spbtrs.c index 526606239..f5dcfd27a 100644 --- a/src/map/lapack2flamec/f2c/c/spbtrs.c +++ b/src/map/lapack2flamec/f2c/c/spbtrs.c @@ -126,7 +126,7 @@ int spbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, integ extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -183,7 +183,7 @@ int spbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, real *ab, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SPBTRS", &i__1); + xerbla_("SPBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spftrf.c b/src/map/lapack2flamec/f2c/c/spftrf.c index 9654da95e..d86b49d93 100644 --- a/src/map/lapack2flamec/f2c/c/spftrf.c +++ b/src/map/lapack2flamec/f2c/c/spftrf.c @@ -202,7 +202,7 @@ int spftrf_(char *transr, char *uplo, integer *n, real *a, integer *info) extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int spotrf_(char *, integer *, real *, integer *, integer *); @@ -244,7 +244,7 @@ int spftrf_(char *transr, char *uplo, integer *n, real *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPFTRF", &i__1); + xerbla_("SPFTRF", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/spftri.c b/src/map/lapack2flamec/f2c/c/spftri.c index 7b321d59d..3c5ee5d0f 100644 --- a/src/map/lapack2flamec/f2c/c/spftri.c +++ b/src/map/lapack2flamec/f2c/c/spftri.c @@ -193,7 +193,7 @@ int spftri_(char *transr, char *uplo, integer *n, real *a, integer *info) extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(char *, integer *); + int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int slauum_(char *, integer *, real *, integer *, integer *), stftri_(char *, char *, char *, integer *, real *, integer *); @@ -235,7 +235,7 @@ int spftri_(char *transr, char *uplo, integer *n, real *a, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPFTRI", &i__1); + xerbla_("SPFTRI", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/spftrs.c b/src/map/lapack2flamec/f2c/c/spftrs.c index 10a564fb6..52d79c894 100644 --- a/src/map/lapack2flamec/f2c/c/spftrs.c +++ b/src/map/lapack2flamec/f2c/c/spftrs.c @@ -198,7 +198,7 @@ int spftrs_(char *transr, char *uplo, integer *n, integer * nrhs, real *a, real extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int stfsm_(char *, char *, char *, char *, char *, integer *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *); + int stfsm_(char *, char *, char *, char *, char *, integer *, integer *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -251,7 +251,7 @@ int spftrs_(char *transr, char *uplo, integer *n, integer * nrhs, real *a, real if (*info != 0) { i__1 = -(*info); - xerbla_("SPFTRS", &i__1); + xerbla_("SPFTRS", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/spocon.c b/src/map/lapack2flamec/f2c/c/spocon.c index d807a85ea..40a82c03b 100644 --- a/src/map/lapack2flamec/f2c/c/spocon.c +++ b/src/map/lapack2flamec/f2c/c/spocon.c @@ -134,7 +134,7 @@ int spocon_(char *uplo, integer *n, real *a, integer *lda, real *anorm, real *rc extern real slamch_(char *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; char normin[1]; @@ -192,7 +192,7 @@ int spocon_(char *uplo, integer *n, real *a, integer *lda, real *anorm, real *rc if (*info != 0) { i__1 = -(*info); - xerbla_("SPOCON", &i__1); + xerbla_("SPOCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spoequ.c b/src/map/lapack2flamec/f2c/c/spoequ.c index fcd44d38a..6b8db1c69 100644 --- a/src/map/lapack2flamec/f2c/c/spoequ.c +++ b/src/map/lapack2flamec/f2c/c/spoequ.c @@ -115,7 +115,7 @@ int spoequ_(integer *n, real *a, integer *lda, real *s, real *scond, real *amax, integer i__; real smin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -153,7 +153,7 @@ int spoequ_(integer *n, real *a, integer *lda, real *s, real *scond, real *amax, if (*info != 0) { i__1 = -(*info); - xerbla_("SPOEQU", &i__1); + xerbla_("SPOEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spoequb.c b/src/map/lapack2flamec/f2c/c/spoequb.c index 10051a2e7..9a6380242 100644 --- a/src/map/lapack2flamec/f2c/c/spoequb.c +++ b/src/map/lapack2flamec/f2c/c/spoequb.c @@ -110,7 +110,7 @@ int spoequb_(integer *n, real *a, integer *lda, real *s, real *scond, real *amax real tmp, base, smin; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -151,7 +151,7 @@ int spoequb_(integer *n, real *a, integer *lda, real *s, real *scond, real *amax if (*info != 0) { i__1 = -(*info); - xerbla_("SPOEQUB", &i__1); + xerbla_("SPOEQUB", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sporfs.c b/src/map/lapack2flamec/f2c/c/sporfs.c index c97a44261..b2179f479 100644 --- a/src/map/lapack2flamec/f2c/c/sporfs.c +++ b/src/map/lapack2flamec/f2c/c/sporfs.c @@ -198,7 +198,7 @@ int sporfs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int spotrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -276,7 +276,7 @@ int sporfs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SPORFS", &i__1); + xerbla_("SPORFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sporfsx.c b/src/map/lapack2flamec/f2c/c/sporfsx.c index 7f91fc8af..30c2973f0 100644 --- a/src/map/lapack2flamec/f2c/c/sporfsx.c +++ b/src/map/lapack2flamec/f2c/c/sporfsx.c @@ -412,7 +412,7 @@ int sporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, real *a, integ logical rcequ; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), spocon_( char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spocon_( char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *); extern real slansy_(char *, char *, integer *, real *, integer *, real *); extern integer ilaprec_(char *); integer ithresh, n_norms__; @@ -560,7 +560,7 @@ int sporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SPORFSX", &i__1); + xerbla_("SPORFSX", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/sposv.c b/src/map/lapack2flamec/f2c/c/sposv.c index 89f8d6539..58263b242 100644 --- a/src/map/lapack2flamec/f2c/c/sposv.c +++ b/src/map/lapack2flamec/f2c/c/sposv.c @@ -130,7 +130,7 @@ int sposv_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real *b /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), spotrf_( char *, integer *, real *, integer *, integer *), spotrs_( char *, integer *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spotrf_( char *, integer *, real *, integer *, integer *), spotrs_( char *, integer *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -180,7 +180,7 @@ int sposv_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real *b if (*info != 0) { i__1 = -(*info); - xerbla_("SPOSV ", &i__1); + xerbla_("SPOSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sposvx.c b/src/map/lapack2flamec/f2c/c/sposvx.c index 2a5bcff89..2fc6f7143 100644 --- a/src/map/lapack2flamec/f2c/c/sposvx.c +++ b/src/map/lapack2flamec/f2c/c/sposvx.c @@ -315,7 +315,7 @@ int sposvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, integer extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -366,6 +366,8 @@ int sposvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, integer *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -455,7 +457,7 @@ int sposvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SPOSVX", &i__1); + xerbla_("SPOSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sposvxx.c b/src/map/lapack2flamec/f2c/c/sposvxx.c index 4044c8dd5..8ebf825af 100644 --- a/src/map/lapack2flamec/f2c/c/sposvxx.c +++ b/src/map/lapack2flamec/f2c/c/sposvxx.c @@ -506,7 +506,7 @@ int sposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, intege extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -655,7 +655,7 @@ int sposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SPOSVXX", &i__1); + xerbla_("SPOSVXX", &i__1, (ftnlen)7); return 0; } if (equil) diff --git a/src/map/lapack2flamec/f2c/c/spotrf2.c b/src/map/lapack2flamec/f2c/c/spotrf2.c index 183e138bb..190ce05f7 100644 --- a/src/map/lapack2flamec/f2c/c/spotrf2.c +++ b/src/map/lapack2flamec/f2c/c/spotrf2.c @@ -110,7 +110,7 @@ int spotrf2_(char *uplo, integer *n, real *a, integer *lda, integer *info) integer iinfo; logical upper; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -155,7 +155,7 @@ int spotrf2_(char *uplo, integer *n, real *a, integer *lda, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPOTRF2", &i__1); + xerbla_("SPOTRF2", &i__1, (ftnlen)7); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/spotrs.c b/src/map/lapack2flamec/f2c/c/spotrs.c index c7b14243a..80eaff8b4 100644 --- a/src/map/lapack2flamec/f2c/c/spotrs.c +++ b/src/map/lapack2flamec/f2c/c/spotrs.c @@ -113,7 +113,7 @@ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -168,7 +168,7 @@ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SPOTRS", &i__1); + xerbla_("SPOTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sppcon.c b/src/map/lapack2flamec/f2c/c/sppcon.c index ce5c25497..f6661ea96 100644 --- a/src/map/lapack2flamec/f2c/c/sppcon.c +++ b/src/map/lapack2flamec/f2c/c/sppcon.c @@ -133,7 +133,7 @@ int sppcon_(char *uplo, integer *n, real *ap, real *anorm, real *rcond, real *wo extern real slamch_(char *); real scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; char normin[1]; @@ -185,7 +185,7 @@ int sppcon_(char *uplo, integer *n, real *ap, real *anorm, real *rcond, real *wo if (*info != 0) { i__1 = -(*info); - xerbla_("SPPCON", &i__1); + xerbla_("SPPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sppequ.c b/src/map/lapack2flamec/f2c/c/sppequ.c index 0c6f99a37..322d99276 100644 --- a/src/map/lapack2flamec/f2c/c/sppequ.c +++ b/src/map/lapack2flamec/f2c/c/sppequ.c @@ -123,7 +123,7 @@ int sppequ_(char *uplo, integer *n, real *ap, real *s, real * scond, real *amax, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -162,7 +162,7 @@ int sppequ_(char *uplo, integer *n, real *ap, real *s, real * scond, real *amax, if (*info != 0) { i__1 = -(*info); - xerbla_("SPPEQU", &i__1); + xerbla_("SPPEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spprfs.c b/src/map/lapack2flamec/f2c/c/spprfs.c index eb8768627..7932f719d 100644 --- a/src/map/lapack2flamec/f2c/c/spprfs.c +++ b/src/map/lapack2flamec/f2c/c/spprfs.c @@ -189,7 +189,7 @@ int spprfs_(char *uplo, integer *n, integer *nrhs, real *ap, real *afp, real *b, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int spptrs_(char *, integer *, integer *, real *, real *, integer *, integer *); @@ -255,7 +255,7 @@ int spprfs_(char *uplo, integer *n, integer *nrhs, real *ap, real *afp, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("SPPRFS", &i__1); + xerbla_("SPPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sppsv.c b/src/map/lapack2flamec/f2c/c/sppsv.c index 8b1c1d390..7a0ef6248 100644 --- a/src/map/lapack2flamec/f2c/c/sppsv.c +++ b/src/map/lapack2flamec/f2c/c/sppsv.c @@ -145,7 +145,7 @@ int sppsv_(char *uplo, integer *n, integer *nrhs, real *ap, real *b, integer *ld /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), spptrf_( char *, integer *, real *, integer *), spptrs_(char *, integer *, integer *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spptrf_( char *, integer *, real *, integer *), spptrs_(char *, integer *, integer *, real *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -189,7 +189,7 @@ int sppsv_(char *uplo, integer *n, integer *nrhs, real *ap, real *b, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SPPSV ", &i__1); + xerbla_("SPPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sppsvx.c b/src/map/lapack2flamec/f2c/c/sppsvx.c index ca05b1b00..042cf7f93 100644 --- a/src/map/lapack2flamec/f2c/c/sppsvx.c +++ b/src/map/lapack2flamec/f2c/c/sppsvx.c @@ -326,7 +326,7 @@ int sppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *ap, real * extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -375,6 +375,8 @@ int sppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *ap, real * *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.f; + bignum = 0.f; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -456,7 +458,7 @@ int sppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *ap, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SPPSVX", &i__1); + xerbla_("SPPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spptrf.c b/src/map/lapack2flamec/f2c/c/spptrf.c index 970e1172c..3cdd177a2 100644 --- a/src/map/lapack2flamec/f2c/c/spptrf.c +++ b/src/map/lapack2flamec/f2c/c/spptrf.c @@ -134,7 +134,7 @@ int spptrf_(char *uplo, integer *n, real *ap, integer *info) int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -172,7 +172,7 @@ int spptrf_(char *uplo, integer *n, real *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPPTRF", &i__1); + xerbla_("SPPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spptri.c b/src/map/lapack2flamec/f2c/c/spptri.c index ed5f25c15..7cad2cb28 100644 --- a/src/map/lapack2flamec/f2c/c/spptri.c +++ b/src/map/lapack2flamec/f2c/c/spptri.c @@ -106,7 +106,7 @@ int spptri_(char *uplo, integer *n, real *ap, integer *info) int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *), stptri_(char *, char *, integer *, real *, integer *); + int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), stptri_(char *, char *, integer *, real *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -142,7 +142,7 @@ int spptri_(char *uplo, integer *n, real *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SPPTRI", &i__1); + xerbla_("SPPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spptrs.c b/src/map/lapack2flamec/f2c/c/spptrs.c index 23e0b0628..b6ffde961 100644 --- a/src/map/lapack2flamec/f2c/c/spptrs.c +++ b/src/map/lapack2flamec/f2c/c/spptrs.c @@ -113,7 +113,7 @@ int spptrs_(char *uplo, integer *n, integer *nrhs, real *ap, real *b, integer *l extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -160,7 +160,7 @@ int spptrs_(char *uplo, integer *n, integer *nrhs, real *ap, real *b, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SPPTRS", &i__1); + xerbla_("SPPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spstf2.c b/src/map/lapack2flamec/f2c/c/spstf2.c index dd59de06d..0e702ef29 100644 --- a/src/map/lapack2flamec/f2c/c/spstf2.c +++ b/src/map/lapack2flamec/f2c/c/spstf2.c @@ -161,7 +161,7 @@ int spstf2_(char *uplo, integer *n, real *a, integer *lda, integer *piv, integer real sstop; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer smaxloc_(real *, integer *); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -209,7 +209,7 @@ int spstf2_(char *uplo, integer *n, real *a, integer *lda, integer *piv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SPSTF2", &i__1); + xerbla_("SPSTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spstrf.c b/src/map/lapack2flamec/f2c/c/spstrf.c index d1be5e805..115d71ebb 100644 --- a/src/map/lapack2flamec/f2c/c/spstrf.c +++ b/src/map/lapack2flamec/f2c/c/spstrf.c @@ -164,7 +164,7 @@ int spstrf_(char *uplo, integer *n, real *a, integer *lda, integer *piv, integer int ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer *), spstf2_(char *, integer *, real *, integer *, integer *, integer *, real *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *), smaxloc_(real *, integer *); extern logical sisnan_(real *); /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -212,7 +212,7 @@ int spstrf_(char *uplo, integer *n, real *a, integer *lda, integer *piv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SPSTRF", &i__1); + xerbla_("SPSTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sptcon.c b/src/map/lapack2flamec/f2c/c/sptcon.c index 9dc8acccf..bbf70aa1f 100644 --- a/src/map/lapack2flamec/f2c/c/sptcon.c +++ b/src/map/lapack2flamec/f2c/c/sptcon.c @@ -120,7 +120,7 @@ int sptcon_(integer *n, real *d__, real *e, real *anorm, real *rcond, real *work /* Local variables */ integer i__, ix; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; /* -- LAPACK computational routine (version 3.4.2) -- */ @@ -161,7 +161,7 @@ int sptcon_(integer *n, real *d__, real *e, real *anorm, real *rcond, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("SPTCON", &i__1); + xerbla_("SPTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spteqr.c b/src/map/lapack2flamec/f2c/c/spteqr.c index 4b613c781..929dd400c 100644 --- a/src/map/lapack2flamec/f2c/c/spteqr.c +++ b/src/map/lapack2flamec/f2c/c/spteqr.c @@ -159,7 +159,7 @@ int spteqr_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz integer nru; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), sbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), sbdsqr_(char *, integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); integer icompz; extern /* Subroutine */ int spttrf_(integer *, real *, real *, integer *); @@ -226,7 +226,7 @@ int spteqr_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz if (*info != 0) { i__1 = -(*info); - xerbla_("SPTEQR", &i__1); + xerbla_("SPTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sptrfs.c b/src/map/lapack2flamec/f2c/c/sptrfs.c index 963044de3..377718b88 100644 --- a/src/map/lapack2flamec/f2c/c/sptrfs.c +++ b/src/map/lapack2flamec/f2c/c/sptrfs.c @@ -172,7 +172,7 @@ int sptrfs_(integer *n, integer *nrhs, real *d__, real *e, real *df, real *ef, r extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real lstres; extern /* Subroutine */ @@ -233,7 +233,7 @@ int sptrfs_(integer *n, integer *nrhs, real *d__, real *e, real *df, real *ef, r if (*info != 0) { i__1 = -(*info); - xerbla_("SPTRFS", &i__1); + xerbla_("SPTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sptsv.c b/src/map/lapack2flamec/f2c/c/sptsv.c index 23551065d..25a1d021c 100644 --- a/src/map/lapack2flamec/f2c/c/sptsv.c +++ b/src/map/lapack2flamec/f2c/c/sptsv.c @@ -112,7 +112,7 @@ int sptsv_(integer *n, integer *nrhs, real *d__, real *e, real *b, integer *ldb, integer b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), spttrf_( integer *, real *, real *, integer *), spttrs_(integer *, integer *, real *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spttrf_( integer *, real *, real *, integer *), spttrs_(integer *, integer *, real *, real *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -151,7 +151,7 @@ int sptsv_(integer *n, integer *nrhs, real *d__, real *e, real *b, integer *ldb, if (*info != 0) { i__1 = -(*info); - xerbla_("SPTSV ", &i__1); + xerbla_("SPTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sptsvx.c b/src/map/lapack2flamec/f2c/c/sptsvx.c index a10d68444..dae15535c 100644 --- a/src/map/lapack2flamec/f2c/c/sptsvx.c +++ b/src/map/lapack2flamec/f2c/c/sptsvx.c @@ -232,7 +232,7 @@ int sptsvx_(char *fact, integer *n, integer *nrhs, real *d__, real *e, real *df, extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); extern real slanst_(char *, integer *, real *, real *); extern /* Subroutine */ int sptcon_(integer *, real *, real *, real *, real *, real *, integer *), sptrfs_(integer *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *), spttrf_(integer *, real *, real *, integer *), spttrs_(integer *, integer *, real *, real *, real *, integer *, integer *); @@ -297,7 +297,7 @@ int sptsvx_(char *fact, integer *n, integer *nrhs, real *d__, real *e, real *df, if (*info != 0) { i__1 = -(*info); - xerbla_("SPTSVX", &i__1); + xerbla_("SPTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spttrf.c b/src/map/lapack2flamec/f2c/c/spttrf.c index 5ffd4497b..a9fc58d9f 100644 --- a/src/map/lapack2flamec/f2c/c/spttrf.c +++ b/src/map/lapack2flamec/f2c/c/spttrf.c @@ -92,7 +92,7 @@ int spttrf_(integer *n, real *d__, real *e, integer *info) integer i__, i4; real ei; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -121,7 +121,7 @@ int spttrf_(integer *n, real *d__, real *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("SPTTRF", &i__1); + xerbla_("SPTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/spttrs.c b/src/map/lapack2flamec/f2c/c/spttrs.c index 3ca06853a..c76516ca3 100644 --- a/src/map/lapack2flamec/f2c/c/spttrs.c +++ b/src/map/lapack2flamec/f2c/c/spttrs.c @@ -111,7 +111,7 @@ int spttrs_(integer *n, integer *nrhs, real *d__, real *e, real *b, integer *ldb /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int sptts2_(integer *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *); + int sptts2_(integer *, integer *, real *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -155,7 +155,7 @@ int spttrs_(integer *n, integer *nrhs, real *d__, real *e, real *b, integer *ldb if (*info != 0) { i__1 = -(*info); - xerbla_("SPTTRS", &i__1); + xerbla_("SPTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssb2st_kernels.c b/src/map/lapack2flamec/f2c/c/ssb2st_kernels.c index 6dbb9fcad..adc5f2c92 100644 --- a/src/map/lapack2flamec/f2c/c/ssb2st_kernels.c +++ b/src/map/lapack2flamec/f2c/c/ssb2st_kernels.c @@ -178,7 +178,6 @@ int ssb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in integer dpos, vpos; extern logical lsame_(char *, char *); logical upper; - integer ajeter; extern /* Subroutine */ int slarfg_(integer *, real *, real *, integer *, real *); integer ofdpos; @@ -213,7 +212,6 @@ int ssb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in --tau; --work; /* Function Body */ - ajeter = *ib + *ldvt; upper = lsame_(uplo, "U"); if (upper) { diff --git a/src/map/lapack2flamec/f2c/c/ssbev.c b/src/map/lapack2flamec/f2c/c/ssbev.c index 3c69966b0..4464bc937 100644 --- a/src/map/lapack2flamec/f2c/c/ssbev.c +++ b/src/map/lapack2flamec/f2c/c/ssbev.c @@ -166,7 +166,7 @@ int ssbev_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, integer *l extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -238,7 +238,7 @@ int ssbev_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEV ", &i__1); + xerbla_("SSBEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbev_2stage.c b/src/map/lapack2flamec/f2c/c/ssbev_2stage.c index 2b497a45d..c1f64355b 100644 --- a/src/map/lapack2flamec/f2c/c/ssbev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssbev_2stage.c @@ -235,7 +235,7 @@ int ssbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, int extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -331,7 +331,7 @@ int ssbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEV_2STAGE ", &i__1); + xerbla_("SSBEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbevd.c b/src/map/lapack2flamec/f2c/c/ssbevd.c index fa28c8328..d24964838 100644 --- a/src/map/lapack2flamec/f2c/c/ssbevd.c +++ b/src/map/lapack2flamec/f2c/c/ssbevd.c @@ -215,7 +215,7 @@ int ssbevd_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, integer * extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -321,7 +321,7 @@ int ssbevd_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEVD", &i__1); + xerbla_("SSBEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbevd_2stage.c b/src/map/lapack2flamec/f2c/c/ssbevd_2stage.c index 8ebf90eea..26cec0540 100644 --- a/src/map/lapack2flamec/f2c/c/ssbevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssbevd_2stage.c @@ -265,7 +265,7 @@ int ssbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, in extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -379,7 +379,7 @@ int ssbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, real *ab, in if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEVD_2STAGE", &i__1); + xerbla_("SSBEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbevx.c b/src/map/lapack2flamec/f2c/c/ssbevx.c index dc3e7f722..068a421e0 100644 --- a/src/map/lapack2flamec/f2c/c/ssbevx.c +++ b/src/map/lapack2flamec/f2c/c/ssbevx.c @@ -292,7 +292,7 @@ int ssbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, real * extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -408,7 +408,7 @@ int ssbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEVX", &i__1); + xerbla_("SSBEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbevx_2stage.c b/src/map/lapack2flamec/f2c/c/ssbevx_2stage.c index 4d74900b4..71fde652c 100644 --- a/src/map/lapack2flamec/f2c/c/ssbevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssbevx_2stage.c @@ -366,7 +366,7 @@ int ssbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; extern real slansb_(char *, char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ @@ -507,7 +507,7 @@ int ssbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, if (*info != 0) { i__1 = -(*info); - xerbla_("SSBEVX_2STAGE ", &i__1); + xerbla_("SSBEVX_2STAGE ", &i__1, (ftnlen)14); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbgst.c b/src/map/lapack2flamec/f2c/c/ssbgst.c index ed8ffa54c..d0de1a4e4 100644 --- a/src/map/lapack2flamec/f2c/c/ssbgst.c +++ b/src/map/lapack2flamec/f2c/c/ssbgst.c @@ -181,7 +181,7 @@ int ssbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, real * int sscal_(integer *, real *, real *, integer *); logical upper, wantx; extern /* Subroutine */ - int slar2v_(integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int slar2v_(integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical update; extern /* Subroutine */ int slaset_(char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slargv_(integer *, real *, integer *, real *, integer *, real *, integer *), slartv_(integer *, real *, integer *, real *, integer *, real *, real *, integer *); @@ -258,7 +258,7 @@ int ssbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSBGST", &i__1); + xerbla_("SSBGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbgv.c b/src/map/lapack2flamec/f2c/c/ssbgv.c index 0bd93f90d..224278687 100644 --- a/src/map/lapack2flamec/f2c/c/ssbgv.c +++ b/src/map/lapack2flamec/f2c/c/ssbgv.c @@ -184,7 +184,7 @@ int ssbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, real *a integer iinfo; logical upper, wantz; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer indwrk; extern /* Subroutine */ int spbstf_(char *, integer *, integer *, real *, integer *, integer *), ssbtrd_(char *, char *, integer *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *), ssbgst_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), ssterf_(integer *, real *, real *, integer *), ssteqr_(char *, integer *, real *, real *, real *, integer *, real *, integer *); @@ -256,7 +256,7 @@ int ssbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("SSBGV ", &i__1); + xerbla_("SSBGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbgvd.c b/src/map/lapack2flamec/f2c/c/ssbgvd.c index 5a616c481..c1328eb29 100644 --- a/src/map/lapack2flamec/f2c/c/ssbgvd.c +++ b/src/map/lapack2flamec/f2c/c/ssbgvd.c @@ -242,7 +242,7 @@ int ssbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, real * logical upper, wantz; integer indwk2, llwrk2; extern /* Subroutine */ - int xerbla_(char *, integer *), sstedc_( char *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), sstedc_( char *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); integer indwrk, liwmin; extern /* Subroutine */ int spbstf_(char *, integer *, integer *, real *, integer *, integer *), ssbtrd_(char *, char *, integer *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *), ssbgst_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), ssterf_(integer *, real *, real *, integer *); @@ -349,7 +349,7 @@ int ssbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSBGVD", &i__1); + xerbla_("SSBGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbgvx.c b/src/map/lapack2flamec/f2c/c/ssbgvx.c index 83f44b006..58ce6f14d 100644 --- a/src/map/lapack2flamec/f2c/c/ssbgvx.c +++ b/src/map/lapack2flamec/f2c/c/ssbgvx.c @@ -307,7 +307,7 @@ int ssbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege integer indibl; logical valeig; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer indisp, indiwo; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -429,7 +429,7 @@ int ssbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SSBGVX", &i__1); + xerbla_("SSBGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssbtrd.c b/src/map/lapack2flamec/f2c/c/ssbtrd.c index 9fc78cb65..564c5c634 100644 --- a/src/map/lapack2flamec/f2c/c/ssbtrd.c +++ b/src/map/lapack2flamec/f2c/c/ssbtrd.c @@ -184,7 +184,7 @@ int ssbtrd_(char *vect, char *uplo, integer *n, integer *kd, real *ab, integer * int slar2v_(integer *, real *, real *, real *, integer *, real *, real *, integer *); integer iqaend; extern /* Subroutine */ - int xerbla_(char *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slargv_( integer *, real *, integer *, real *, integer *, real *, integer * ), slartv_(integer *, real *, integer *, real *, integer *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), slartg_(real *, real *, real *, real *, real *), slargv_( integer *, real *, integer *, real *, integer *, real *, integer * ), slartv_(integer *, real *, integer *, real *, integer *, real *, real *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -252,7 +252,7 @@ int ssbtrd_(char *vect, char *uplo, integer *n, integer *kd, real *ab, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SSBTRD", &i__1); + xerbla_("SSBTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssfrk.c b/src/map/lapack2flamec/f2c/c/ssfrk.c index 7447e4776..9793f01f0 100644 --- a/src/map/lapack2flamec/f2c/c/ssfrk.c +++ b/src/map/lapack2flamec/f2c/c/ssfrk.c @@ -171,7 +171,7 @@ int ssfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, real * integer nrowa; logical lower; extern /* Subroutine */ - int ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int ssyrk_(char *, char *, integer *, integer *, real *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -239,7 +239,7 @@ int ssfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, real * if (info != 0) { i__1 = -info; - xerbla_("SSFRK ", &i__1); + xerbla_("SSFRK ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspcon.c b/src/map/lapack2flamec/f2c/c/sspcon.c index cfd91266d..95e752d0d 100644 --- a/src/map/lapack2flamec/f2c/c/sspcon.c +++ b/src/map/lapack2flamec/f2c/c/sspcon.c @@ -129,7 +129,7 @@ int sspcon_(char *uplo, integer *n, real *ap, integer *ipiv, real *anorm, real * integer isave[3]; logical upper; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int ssptrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -177,7 +177,7 @@ int sspcon_(char *uplo, integer *n, real *ap, integer *ipiv, real *anorm, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSPCON", &i__1); + xerbla_("SSPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspev.c b/src/map/lapack2flamec/f2c/c/sspev.c index 8f6504f8b..a440b925c 100644 --- a/src/map/lapack2flamec/f2c/c/sspev.c +++ b/src/map/lapack2flamec/f2c/c/sspev.c @@ -150,7 +150,7 @@ int sspev_(char *jobz, char *uplo, integer *n, real *ap, real *w, real *z__, int extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau, indwrk; extern real slansp_(char *, char *, integer *, real *, real *); @@ -209,7 +209,7 @@ int sspev_(char *jobz, char *uplo, integer *n, real *ap, real *w, real *z__, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSPEV ", &i__1); + xerbla_("SSPEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspevd.c b/src/map/lapack2flamec/f2c/c/sspevd.c index 061ce1a6e..ba3452bf2 100644 --- a/src/map/lapack2flamec/f2c/c/sspevd.c +++ b/src/map/lapack2flamec/f2c/c/sspevd.c @@ -198,7 +198,7 @@ int sspevd_(char *jobz, char *uplo, integer *n, real *ap, real *w, real *z__, in extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indtau; extern /* Subroutine */ @@ -299,7 +299,7 @@ int sspevd_(char *jobz, char *uplo, integer *n, real *ap, real *w, real *z__, in if (*info != 0) { i__1 = -(*info); - xerbla_("SSPEVD", &i__1); + xerbla_("SSPEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspevx.c b/src/map/lapack2flamec/f2c/c/sspevx.c index 34a2498fd..d2850af73 100644 --- a/src/map/lapack2flamec/f2c/c/sspevx.c +++ b/src/map/lapack2flamec/f2c/c/sspevx.c @@ -256,7 +256,7 @@ int sspevx_(char *jobz, char *range, char *uplo, integer *n, real *ap, real *vl, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp, indiwo, indwrk; extern real slansp_(char *, char *, integer *, real *, real *); @@ -351,7 +351,7 @@ int sspevx_(char *jobz, char *range, char *uplo, integer *n, real *ap, real *vl, if (*info != 0) { i__1 = -(*info); - xerbla_("SSPEVX", &i__1); + xerbla_("SSPEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspgst.c b/src/map/lapack2flamec/f2c/c/sspgst.c index 21acb3df0..89104312d 100644 --- a/src/map/lapack2flamec/f2c/c/sspgst.c +++ b/src/map/lapack2flamec/f2c/c/sspgst.c @@ -132,7 +132,7 @@ int sspgst_(integer *itype, char *uplo, integer *n, real *ap, real *bp, integer int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int saxpy_(integer *, real *, real *, integer *, real *, integer *), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), stpmv_( char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int saxpy_(integer *, real *, real *, integer *, real *, integer *), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), stpmv_( char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -173,7 +173,7 @@ int sspgst_(integer *itype, char *uplo, integer *n, real *ap, real *bp, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSPGST", &i__1); + xerbla_("SSPGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspgv.c b/src/map/lapack2flamec/f2c/c/sspgv.c index 31c114570..43a0ea215 100644 --- a/src/map/lapack2flamec/f2c/c/sspgv.c +++ b/src/map/lapack2flamec/f2c/c/sspgv.c @@ -173,7 +173,7 @@ int sspgv_(integer *itype, char *jobz, char *uplo, integer * n, real *ap, real * int sspev_(char *, char *, integer *, real *, real *, real *, integer *, real *, integer *); logical wantz; extern /* Subroutine */ - int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *), spptrf_(char *, integer *, real *, integer *), sspgst_(integer *, char *, integer *, real *, real *, integer *); + int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), spptrf_(char *, integer *, real *, integer *), sspgst_(integer *, char *, integer *, real *, real *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -226,7 +226,7 @@ int sspgv_(integer *itype, char *jobz, char *uplo, integer * n, real *ap, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSPGV ", &i__1); + xerbla_("SSPGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspgvd.c b/src/map/lapack2flamec/f2c/c/sspgvd.c index ad02df3f0..3734c9941 100644 --- a/src/map/lapack2flamec/f2c/c/sspgvd.c +++ b/src/map/lapack2flamec/f2c/c/sspgvd.c @@ -223,7 +223,7 @@ int sspgvd_(integer *itype, char *jobz, char *uplo, integer * n, real *ap, real char trans[1]; logical upper, wantz; extern /* Subroutine */ - int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer liwmin; extern /* Subroutine */ int sspevd_(char *, char *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, integer *), spptrf_(char *, integer *, real *, integer *); @@ -319,7 +319,7 @@ int sspgvd_(integer *itype, char *jobz, char *uplo, integer * n, real *ap, real if (*info != 0) { i__1 = -(*info); - xerbla_("SSPGVD", &i__1); + xerbla_("SSPGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspgvx.c b/src/map/lapack2flamec/f2c/c/sspgvx.c index f738a9bc5..cc30ca52f 100644 --- a/src/map/lapack2flamec/f2c/c/sspgvx.c +++ b/src/map/lapack2flamec/f2c/c/sspgvx.c @@ -275,7 +275,7 @@ int sspgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, re int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), stpsv_(char *, char *, char *, integer *, real *, real *, integer *); logical alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *), spptrf_( char *, integer *, real *, integer *), sspgst_(integer *, char *, integer *, real *, real *, integer *), sspevx_( char *, char *, char *, integer *, real *, real *, real *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *, integer *) ; + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), spptrf_( char *, integer *, real *, integer *), sspgst_(integer *, char *, integer *, real *, real *, integer *), sspevx_( char *, char *, char *, integer *, real *, real *, real *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *, integer *) ; /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -363,7 +363,7 @@ int sspgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSPGVX", &i__1); + xerbla_("SSPGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssprfs.c b/src/map/lapack2flamec/f2c/c/ssprfs.c index aaf5c1b9f..2c7c037c1 100644 --- a/src/map/lapack2flamec/f2c/c/ssprfs.c +++ b/src/map/lapack2flamec/f2c/c/ssprfs.c @@ -197,7 +197,7 @@ int ssprfs_(char *uplo, integer *n, integer *nrhs, real *ap, real *afp, integer extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int ssptrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -264,7 +264,7 @@ int ssprfs_(char *uplo, integer *n, integer *nrhs, real *ap, real *afp, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSPRFS", &i__1); + xerbla_("SSPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspsv.c b/src/map/lapack2flamec/f2c/c/sspsv.c index 29383acb1..ecae96a88 100644 --- a/src/map/lapack2flamec/f2c/c/sspsv.c +++ b/src/map/lapack2flamec/f2c/c/sspsv.c @@ -163,7 +163,7 @@ int sspsv_(char *uplo, integer *n, integer *nrhs, real *ap, integer *ipiv, real /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), ssptrf_( char *, integer *, real *, integer *, integer *), ssptrs_( char *, integer *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ssptrf_( char *, integer *, real *, integer *, integer *), ssptrs_( char *, integer *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -208,7 +208,7 @@ int sspsv_(char *uplo, integer *n, integer *nrhs, real *ap, integer *ipiv, real if (*info != 0) { i__1 = -(*info); - xerbla_("SSPSV ", &i__1); + xerbla_("SSPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sspsvx.c b/src/map/lapack2flamec/f2c/c/sspsvx.c index ae6ad0b60..80f0c8d37 100644 --- a/src/map/lapack2flamec/f2c/c/sspsvx.c +++ b/src/map/lapack2flamec/f2c/c/sspsvx.c @@ -283,7 +283,7 @@ int sspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *ap, real * extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); extern real slansp_(char *, char *, integer *, real *, real *); extern /* Subroutine */ int sspcon_(char *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), ssprfs_( char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), ssptrf_(char *, integer *, real *, integer *, integer *), ssptrs_(char *, integer *, integer *, real *, integer *, real *, integer *, integer *); @@ -352,7 +352,7 @@ int sspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *ap, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSPSVX", &i__1); + xerbla_("SSPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssptrd.c b/src/map/lapack2flamec/f2c/c/ssptrd.c index c11e074da..9d692cf52 100644 --- a/src/map/lapack2flamec/f2c/c/ssptrd.c +++ b/src/map/lapack2flamec/f2c/c/ssptrd.c @@ -165,7 +165,7 @@ int ssptrd_(char *uplo, integer *n, real *ap, real *d__, real *e, real *tau, int extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int saxpy_(integer *, real *, real *, integer *, real *, integer *), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int saxpy_(integer *, real *, real *, integer *, real *, integer *), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -204,7 +204,7 @@ int ssptrd_(char *uplo, integer *n, real *ap, real *d__, real *e, real *tau, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSPTRD", &i__1); + xerbla_("SSPTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssptrf.c b/src/map/lapack2flamec/f2c/c/ssptrf.c index d31afa181..1cfbea6aa 100644 --- a/src/map/lapack2flamec/f2c/c/ssptrf.c +++ b/src/map/lapack2flamec/f2c/c/ssptrf.c @@ -180,7 +180,7 @@ int ssptrf_(char *uplo, integer *n, real *ap, integer *ipiv, integer *info) int sswap_(integer *, real *, integer *, real *, integer *); real absakk; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real colmax, rowmax; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -210,6 +210,7 @@ int ssptrf_(char *uplo, integer *n, real *ap, integer *ipiv, integer *info) /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -221,7 +222,7 @@ int ssptrf_(char *uplo, integer *n, real *ap, integer *ipiv, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("SSPTRF", &i__1); + xerbla_("SSPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssptri.c b/src/map/lapack2flamec/f2c/c/ssptri.c index 5e0b3c03d..6c8081e41 100644 --- a/src/map/lapack2flamec/f2c/c/ssptri.c +++ b/src/map/lapack2flamec/f2c/c/ssptri.c @@ -125,7 +125,7 @@ int ssptri_(char *uplo, integer *n, real *ap, integer *ipiv, real *work, integer integer kstep; logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), sspmv_(char *, integer *, real *, real *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -166,7 +166,7 @@ int ssptri_(char *uplo, integer *n, real *ap, integer *ipiv, real *work, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSPTRI", &i__1); + xerbla_("SSPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssptrs.c b/src/map/lapack2flamec/f2c/c/ssptrs.c index ea1c83959..ded45fe49 100644 --- a/src/map/lapack2flamec/f2c/c/ssptrs.c +++ b/src/map/lapack2flamec/f2c/c/ssptrs.c @@ -131,7 +131,7 @@ int ssptrs_(char *uplo, integer *n, integer *nrhs, real *ap, integer *ipiv, real int sscal_(integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -180,7 +180,7 @@ int ssptrs_(char *uplo, integer *n, integer *nrhs, real *ap, integer *ipiv, real if (*info != 0) { i__1 = -(*info); - xerbla_("SSPTRS", &i__1); + xerbla_("SSPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstebz.c b/src/map/lapack2flamec/f2c/c/sstebz.c index 6eaaf33cd..2cc0cc139 100644 --- a/src/map/lapack2flamec/f2c/c/sstebz.c +++ b/src/map/lapack2flamec/f2c/c/sstebz.c @@ -291,7 +291,7 @@ int sstebz_(char *range, char *order, integer *n, real *vl, real *vu, integer *i real safemn; integer idumma[1]; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer idiscu; extern /* Subroutine */ @@ -332,6 +332,8 @@ int sstebz_(char *range, char *order, integer *n, real *vl, real *vu, integer *i --d__; /* Function Body */ *info = 0; + wlu = 0; + wul = 0; /* Decode RANGE */ if (lsame_(range, "A")) { @@ -393,7 +395,7 @@ int sstebz_(char *range, char *order, integer *n, real *vl, real *vu, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEBZ", &i__1); + xerbla_("SSTEBZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstedc.c b/src/map/lapack2flamec/f2c/c/sstedc.c index 27c445498..51fe07d2e 100644 --- a/src/map/lapack2flamec/f2c/c/sstedc.c +++ b/src/map/lapack2flamec/f2c/c/sstedc.c @@ -210,7 +210,7 @@ int sstedc_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz int sswap_(integer *, real *, integer *, real *, integer *), slaed0_(integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer finish; extern /* Subroutine */ @@ -257,6 +257,8 @@ int sstedc_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz /* Function Body */ *info = 0; lquery = *lwork == -1 || *liwork == -1; + lwmin = 0; + liwmin = 0; if (lsame_(compz, "N")) { icompz = 0; @@ -339,7 +341,7 @@ int sstedc_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEDC", &i__1); + xerbla_("SSTEDC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstein.c b/src/map/lapack2flamec/f2c/c/sstein.c index ef5032ffc..f3e1df610 100644 --- a/src/map/lapack2flamec/f2c/c/sstein.c +++ b/src/map/lapack2flamec/f2c/c/sstein.c @@ -192,7 +192,7 @@ int sstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock integer indrv1, indrv2, indrv3, indrv4, indrv5; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slagtf_( integer *, real *, real *, real *, real *, real *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slagtf_( integer *, real *, real *, real *, real *, real *, real *, integer *, integer *); integer nrmchk; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ @@ -240,6 +240,11 @@ int sstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock /* Function Body */ *info = 0; i__1 = *m; + stpcrt = 0.f; + onenrm = 0.f; + ortol = 0.f; + xjm = 0.f; + gpind = 0; for (i__ = 1; i__ <= i__1; ++i__) @@ -284,7 +289,7 @@ int sstein_(integer *n, real *d__, real *e, integer *m, real *w, integer *iblock if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEIN", &i__1); + xerbla_("SSTEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstemr.c b/src/map/lapack2flamec/f2c/c/sstemr.c index 32ba59e17..ac6537161 100644 --- a/src/map/lapack2flamec/f2c/c/sstemr.c +++ b/src/map/lapack2flamec/f2c/c/sstemr.c @@ -354,7 +354,7 @@ int sstemr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r integer wbegin; real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer inderr, iindwk, indgrs, offset; extern /* Subroutine */ @@ -524,7 +524,7 @@ int sstemr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEMR", &i__1); + xerbla_("SSTEMR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssteqr.c b/src/map/lapack2flamec/f2c/c/ssteqr.c index e19924e64..b0ea29b21 100644 --- a/src/map/lapack2flamec/f2c/c/ssteqr.c +++ b/src/map/lapack2flamec/f2c/c/ssteqr.c @@ -161,7 +161,7 @@ int ssteqr_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -235,7 +235,7 @@ int ssteqr_(char *compz, integer *n, real *d__, real *e, real *z__, integer *ldz if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEQR", &i__1); + xerbla_("SSTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssterf.c b/src/map/lapack2flamec/f2c/c/ssterf.c index 883bbae41..6ae50aa29 100644 --- a/src/map/lapack2flamec/f2c/c/ssterf.c +++ b/src/map/lapack2flamec/f2c/c/ssterf.c @@ -108,7 +108,7 @@ int ssterf_(integer *n, real *d__, real *e, integer *info) extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real safmax; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -150,7 +150,7 @@ int ssterf_(integer *n, real *d__, real *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("SSTERF", &i__1); + xerbla_("SSTERF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstev.c b/src/map/lapack2flamec/f2c/c/sstev.c index e0107f919..23e7c9151 100644 --- a/src/map/lapack2flamec/f2c/c/sstev.c +++ b/src/map/lapack2flamec/f2c/c/sstev.c @@ -131,7 +131,7 @@ int sstev_(char *jobz, integer *n, real *d__, real *e, real * z__, integer *ldz, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern real slanst_(char *, integer *, real *, real *); extern /* Subroutine */ @@ -185,7 +185,7 @@ int sstev_(char *jobz, integer *n, real *d__, real *e, real * z__, integer *ldz, if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEV ", &i__1); + xerbla_("SSTEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstevd.c b/src/map/lapack2flamec/f2c/c/sstevd.c index 3c7ef9a83..87d15a927 100644 --- a/src/map/lapack2flamec/f2c/c/sstevd.c +++ b/src/map/lapack2flamec/f2c/c/sstevd.c @@ -178,7 +178,7 @@ int sstevd_(char *jobz, integer *n, real *d__, real *e, real *z__, integer *ldz, extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int sstedc_(char *, integer *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, integer *); @@ -258,7 +258,7 @@ int sstevd_(char *jobz, integer *n, real *d__, real *e, real *z__, integer *ldz, if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEVD", &i__1); + xerbla_("SSTEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstevr.c b/src/map/lapack2flamec/f2c/c/sstevr.c index eaf513682..9e9f84b45 100644 --- a/src/map/lapack2flamec/f2c/c/sstevr.c +++ b/src/map/lapack2flamec/f2c/c/sstevr.c @@ -336,7 +336,7 @@ int sstevr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indisp, indiwo, liwmin; logical tryrac; @@ -453,7 +453,7 @@ int sstevr_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEVR", &i__1); + xerbla_("SSTEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/sstevx.c b/src/map/lapack2flamec/f2c/c/sstevx.c index 9e8dee872..d26e72147 100644 --- a/src/map/lapack2flamec/f2c/c/sstevx.c +++ b/src/map/lapack2flamec/f2c/c/sstevx.c @@ -244,7 +244,7 @@ int sstevx_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer indisp, indiwo, indwrk; extern real slanst_(char *, integer *, real *, real *); @@ -336,7 +336,7 @@ int sstevx_(char *jobz, char *range, integer *n, real *d__, real *e, real *vl, r if (*info != 0) { i__1 = -(*info); - xerbla_("SSTEVX", &i__1); + xerbla_("SSTEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssycon.c b/src/map/lapack2flamec/f2c/c/ssycon.c index b449a0b28..e91f74804 100644 --- a/src/map/lapack2flamec/f2c/c/ssycon.c +++ b/src/map/lapack2flamec/f2c/c/ssycon.c @@ -134,7 +134,7 @@ int ssycon_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * integer isave[3]; logical upper; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; extern /* Subroutine */ int ssytrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -190,7 +190,7 @@ int ssycon_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCON", &i__1); + xerbla_("SSYCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssycon_3.c b/src/map/lapack2flamec/f2c/c/ssycon_3.c index ee57d5617..909fbf186 100644 --- a/src/map/lapack2flamec/f2c/c/ssycon_3.c +++ b/src/map/lapack2flamec/f2c/c/ssycon_3.c @@ -178,7 +178,7 @@ int ssycon_3_(char *uplo, integer *n, real *a, integer *lda, real *e, integer *i integer isave[3]; logical upper; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -233,7 +233,7 @@ int ssycon_3_(char *uplo, integer *n, real *a, integer *lda, real *e, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCON_3", &i__1); + xerbla_("SSYCON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssycon_rook.c b/src/map/lapack2flamec/f2c/c/ssycon_rook.c index c70bf5fb6..03d692206 100644 --- a/src/map/lapack2flamec/f2c/c/ssycon_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssycon_rook.c @@ -149,7 +149,7 @@ int ssycon_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, integer isave[3]; logical upper; extern /* Subroutine */ - int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real ainvnm; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -203,7 +203,7 @@ int ssycon_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCON_ROOK", &i__1); + xerbla_("SSYCON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyconv.c b/src/map/lapack2flamec/f2c/c/ssyconv.c index 3156e8b7a..bff76db2a 100644 --- a/src/map/lapack2flamec/f2c/c/ssyconv.c +++ b/src/map/lapack2flamec/f2c/c/ssyconv.c @@ -117,7 +117,7 @@ int ssyconv_(char *uplo, char *way, integer *n, real *a, integer *lda, integer * extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -164,7 +164,7 @@ int ssyconv_(char *uplo, char *way, integer *n, real *a, integer *lda, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCONV", &i__1); + xerbla_("SSYCONV", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyconvf.c b/src/map/lapack2flamec/f2c/c/ssyconvf.c index 7e0094724..5b142da11 100644 --- a/src/map/lapack2flamec/f2c/c/ssyconvf.c +++ b/src/map/lapack2flamec/f2c/c/ssyconvf.c @@ -205,7 +205,7 @@ int ssyconvf_(char *uplo, char *way, integer *n, real *a, integer *lda, real *e, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -252,7 +252,7 @@ int ssyconvf_(char *uplo, char *way, integer *n, real *a, integer *lda, real *e, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCONVF", &i__1); + xerbla_("SSYCONVF", &i__1, (ftnlen)8); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/ssyconvf_rook.c b/src/map/lapack2flamec/f2c/c/ssyconvf_rook.c index 8f408267d..278c06591 100644 --- a/src/map/lapack2flamec/f2c/c/ssyconvf_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssyconvf_rook.c @@ -203,7 +203,7 @@ int ssyconvf_rook_(char *uplo, char *way, integer *n, real * a, integer *lda, re extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -250,7 +250,7 @@ int ssyconvf_rook_(char *uplo, char *way, integer *n, real * a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYCONVF_ROOK", &i__1); + xerbla_("SSYCONVF_ROOK", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyequb.c b/src/map/lapack2flamec/f2c/c/ssyequb.c index d3a7ceba4..fd1e60e26 100644 --- a/src/map/lapack2flamec/f2c/c/ssyequb.c +++ b/src/map/lapack2flamec/f2c/c/ssyequb.c @@ -139,7 +139,7 @@ int ssyequb_(char *uplo, integer *n, real *a, integer *lda, real *s, real *scond real sumsq; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *, real *); @@ -188,7 +188,7 @@ int ssyequb_(char *uplo, integer *n, real *a, integer *lda, real *s, real *scond if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEQUB", &i__1); + xerbla_("SSYEQUB", &i__1, (ftnlen)7); return 0; } up = lsame_(uplo, "U"); diff --git a/src/map/lapack2flamec/f2c/c/ssyev.c b/src/map/lapack2flamec/f2c/c/ssyev.c index 5aa146efe..3d124dce4 100644 --- a/src/map/lapack2flamec/f2c/c/ssyev.c +++ b/src/map/lapack2flamec/f2c/c/ssyev.c @@ -157,7 +157,7 @@ int ssyev_(char *jobz, char *uplo, integer *n, real *a, integer *lda, real *w, r real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -238,7 +238,7 @@ int ssyev_(char *jobz, char *uplo, integer *n, real *a, integer *lda, real *w, r if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEV ", &i__1); + xerbla_("SSYEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyev_2stage.c b/src/map/lapack2flamec/f2c/c/ssyev_2stage.c index 6171121c7..d955b9e90 100644 --- a/src/map/lapack2flamec/f2c/c/ssyev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssyev_2stage.c @@ -213,7 +213,7 @@ int ssyev_2stage_(char *jobz, char *uplo, integer *n, real * a, integer *lda, re extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -293,7 +293,7 @@ int ssyev_2stage_(char *jobz, char *uplo, integer *n, real * a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEV_2STAGE ", &i__1); + xerbla_("SSYEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevd.c b/src/map/lapack2flamec/f2c/c/ssyevd.c index a440e04f0..8cb8c868a 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevd.c +++ b/src/map/lapack2flamec/f2c/c/ssyevd.c @@ -204,7 +204,7 @@ int ssyevd_(char *jobz, char *uplo, integer *n, real *a, integer *lda, real *w, real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -312,7 +312,7 @@ int ssyevd_(char *jobz, char *uplo, integer *n, real *a, integer *lda, real *w, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVD", &i__1); + xerbla_("SSYEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevd_2stage.c b/src/map/lapack2flamec/f2c/c/ssyevd_2stage.c index 42ef8cf49..bd2d4f9ec 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssyevd_2stage.c @@ -256,7 +256,7 @@ int ssyevd_2stage_(char *jobz, char *uplo, integer *n, real *a, integer *lda, re extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); @@ -362,7 +362,7 @@ int ssyevd_2stage_(char *jobz, char *uplo, integer *n, real *a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVD_2STAGE", &i__1); + xerbla_("SSYEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevr.c b/src/map/lapack2flamec/f2c/c/ssyevr.c index f75017ed5..30b5a6324 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevr.c +++ b/src/map/lapack2flamec/f2c/c/ssyevr.c @@ -363,7 +363,7 @@ int ssyevr_(char *jobz, char *range, char *uplo, integer *n, real *a, integer *l real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp, indiwo, indwkn, liwmin; logical tryrac; @@ -499,7 +499,7 @@ int ssyevr_(char *jobz, char *range, char *uplo, integer *n, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVR", &i__1); + xerbla_("SSYEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevr_2stage.c b/src/map/lapack2flamec/f2c/c/ssyevr_2stage.c index fb76fa475..26871796e 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevr_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssyevr_2stage.c @@ -417,7 +417,7 @@ int ssyevr_2stage_(char *jobz, char *range, char *uplo, integer *n, real *a, int real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp, indiwo, indwkn, liwmin; logical tryrac; @@ -552,7 +552,7 @@ int ssyevr_2stage_(char *jobz, char *range, char *uplo, integer *n, real *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVR_2STAGE", &i__1); + xerbla_("SSYEVR_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevx.c b/src/map/lapack2flamec/f2c/c/ssyevx.c index a7d3e8e84..afd19fde8 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevx.c +++ b/src/map/lapack2flamec/f2c/c/ssyevx.c @@ -277,7 +277,7 @@ int ssyevx_(char *jobz, char *range, char *uplo, integer *n, real *a, integer *l real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp, indiwo, indwkn; extern /* Subroutine */ @@ -334,6 +334,7 @@ int ssyevx_(char *jobz, char *range, char *uplo, integer *n, real *a, integer *l indeig = lsame_(range, "I"); lquery = *lwork == -1; *info = 0; + lwkopt = 0; if (! (wantz || lsame_(jobz, "N"))) { *info = -1; @@ -411,7 +412,7 @@ int ssyevx_(char *jobz, char *range, char *uplo, integer *n, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVX", &i__1); + xerbla_("SSYEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyevx_2stage.c b/src/map/lapack2flamec/f2c/c/ssyevx_2stage.c index c701e954f..fce3f569b 100644 --- a/src/map/lapack2flamec/f2c/c/ssyevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssyevx_2stage.c @@ -334,7 +334,7 @@ int ssyevx_2stage_(char *jobz, char *range, char *uplo, integer *n, real *a, int extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real abstll, bignum; integer indtau, indisp, indiwo, indwkn; extern /* Subroutine */ @@ -466,7 +466,7 @@ int ssyevx_2stage_(char *jobz, char *range, char *uplo, integer *n, real *a, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSYEVX_2STAGE", &i__1); + xerbla_("SSYEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssygv.c b/src/map/lapack2flamec/f2c/c/ssygv.c index 1e681213a..bf2776c9b 100644 --- a/src/map/lapack2flamec/f2c/c/ssygv.c +++ b/src/map/lapack2flamec/f2c/c/ssygv.c @@ -189,7 +189,7 @@ int ssygv_(integer *itype, char *jobz, char *uplo, integer * n, real *a, integer int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); logical wantz; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyev_(char *, char *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), ssyev_(char *, char *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -277,7 +277,7 @@ int ssygv_(integer *itype, char *jobz, char *uplo, integer * n, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGV ", &i__1); + xerbla_("SSYGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssygv_2stage.c b/src/map/lapack2flamec/f2c/c/ssygv_2stage.c index 9b1210b15..e9c3e8634 100644 --- a/src/map/lapack2flamec/f2c/c/ssygv_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssygv_2stage.c @@ -246,7 +246,7 @@ int ssygv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, real *a, i int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); logical wantz; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *), spotrf_(char *, integer *, real *, integer *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len), spotrf_(char *, integer *, real *, integer *, integer *); logical lquery; extern /* Subroutine */ int ssygst_(integer *, char *, integer *, real *, integer *, real *, integer *, integer *); @@ -325,7 +325,7 @@ int ssygv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, real *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGV_2STAGE ", &i__1); + xerbla_("SSYGV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssygvd.c b/src/map/lapack2flamec/f2c/c/ssygvd.c index 7b6ec6dc7..e9ed4260d 100644 --- a/src/map/lapack2flamec/f2c/c/ssygvd.c +++ b/src/map/lapack2flamec/f2c/c/ssygvd.c @@ -243,7 +243,7 @@ int ssygvd_(integer *itype, char *jobz, char *uplo, integer * n, real *a, intege int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); logical wantz; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer liwmin; extern /* Subroutine */ int spotrf_(char *, integer *, real *, integer *, integer *), ssyevd_(char *, char *, integer *, real *, integer *, real *, real *, integer *, integer *, integer *, integer *); @@ -345,7 +345,7 @@ int ssygvd_(integer *itype, char *jobz, char *uplo, integer * n, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGVD", &i__1); + xerbla_("SSYGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssygvx.c b/src/map/lapack2flamec/f2c/c/ssygvx.c index 323cbeb52..152d6d791 100644 --- a/src/map/lapack2flamec/f2c/c/ssygvx.c +++ b/src/map/lapack2flamec/f2c/c/ssygvx.c @@ -306,7 +306,7 @@ int ssygvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, re int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); logical alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin; extern /* Subroutine */ @@ -434,7 +434,7 @@ int ssygvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYGVX", &i__1); + xerbla_("SSYGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyrfs.c b/src/map/lapack2flamec/f2c/c/ssyrfs.c index 3a57048d4..6c6b62413 100644 --- a/src/map/lapack2flamec/f2c/c/ssyrfs.c +++ b/src/map/lapack2flamec/f2c/c/ssyrfs.c @@ -206,7 +206,7 @@ int ssyrfs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real lstres; extern /* Subroutine */ int ssytrs_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -285,7 +285,7 @@ int ssyrfs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSYRFS", &i__1); + xerbla_("SSYRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssyrfsx.c b/src/map/lapack2flamec/f2c/c/ssyrfsx.c index 4a68e8448..2075f1666 100644 --- a/src/map/lapack2flamec/f2c/c/ssyrfsx.c +++ b/src/map/lapack2flamec/f2c/c/ssyrfsx.c @@ -420,7 +420,7 @@ int ssyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, real *a, integ logical rcequ; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern real slansy_(char *, char *, integer *, real *, integer *, real *); extern /* Subroutine */ int ssycon_(char *, integer *, real *, integer *, integer *, real *, real *, real *, integer *, integer *); @@ -571,7 +571,7 @@ int ssyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SSYRFSX", &i__1); + xerbla_("SSYRFSX", &i__1, (ftnlen)7); return 0; } /* Quick return if possible. */ diff --git a/src/map/lapack2flamec/f2c/c/ssysv.c b/src/map/lapack2flamec/f2c/c/ssysv.c index 31542c295..003594056 100644 --- a/src/map/lapack2flamec/f2c/c/ssysv.c +++ b/src/map/lapack2flamec/f2c/c/ssysv.c @@ -168,7 +168,7 @@ int ssysv_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, integer /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -243,7 +243,7 @@ int ssysv_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSV ", &i__1); + xerbla_("SSYSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysv_aa.c b/src/map/lapack2flamec/f2c/c/ssysv_aa.c index f8799fc78..fa1113ee7 100644 --- a/src/map/lapack2flamec/f2c/c/ssysv_aa.c +++ b/src/map/lapack2flamec/f2c/c/ssysv_aa.c @@ -167,7 +167,7 @@ int ssysv_aa_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, int extern logical lsame_(char *, char *); integer lwkopt_sytrf__, lwkopt_sytrs__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -243,7 +243,7 @@ int ssysv_aa_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, int if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSV_AA", &i__1); + xerbla_("SSYSV_AA", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/ssysv_aa_2stage.c index cfa4cb389..0a38fc6a6 100644 --- a/src/map/lapack2flamec/f2c/c/ssysv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssysv_aa_2stage.c @@ -192,7 +192,7 @@ int ssysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, real *a, integer *ld extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -267,7 +267,7 @@ int ssysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, real *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSV_AA_2STAGE", &i__1); + xerbla_("SSYSV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysv_rk.c b/src/map/lapack2flamec/f2c/c/ssysv_rk.c index 86a0a1209..9e5d15cb7 100644 --- a/src/map/lapack2flamec/f2c/c/ssysv_rk.c +++ b/src/map/lapack2flamec/f2c/c/ssysv_rk.c @@ -228,7 +228,7 @@ int ssysv_rk_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, rea int ssytrs_3_(char *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), ssytrf_rk_(char *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine -- */ @@ -302,7 +302,7 @@ int ssysv_rk_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSV_RK ", &i__1); + xerbla_("SSYSV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysv_rook.c b/src/map/lapack2flamec/f2c/c/ssysv_rook.c index 5718f7eb5..17266859e 100644 --- a/src/map/lapack2flamec/f2c/c/ssysv_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssysv_rook.c @@ -202,7 +202,7 @@ int ssysv_rook_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, in int ssytrf_rook_(char *, integer *, real *, integer *, integer *, real *, integer *, integer *), ssytrs_rook_(char *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine -- */ @@ -275,7 +275,7 @@ int ssysv_rook_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, in if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSV_ROOK ", &i__1); + xerbla_("SSYSV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysvx.c b/src/map/lapack2flamec/f2c/c/ssysvx.c index 32fcf41a0..9f42ab1bb 100644 --- a/src/map/lapack2flamec/f2c/c/ssysvx.c +++ b/src/map/lapack2flamec/f2c/c/ssysvx.c @@ -289,7 +289,7 @@ int ssysvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, integer extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -404,7 +404,7 @@ int ssysvx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSVX", &i__1); + xerbla_("SSYSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssysvxx.c b/src/map/lapack2flamec/f2c/c/ssysvxx.c index 10e38a1b9..3bb369d00 100644 --- a/src/map/lapack2flamec/f2c/c/ssysvxx.c +++ b/src/map/lapack2flamec/f2c/c/ssysvxx.c @@ -519,7 +519,7 @@ int ssysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, intege extern real slamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; integer infequ; extern /* Subroutine */ @@ -669,7 +669,7 @@ int ssysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SSYSVXX", &i__1); + xerbla_("SSYSVXX", &i__1, (ftnlen)7); return 0; } if (equil) diff --git a/src/map/lapack2flamec/f2c/c/ssytf2.c b/src/map/lapack2flamec/f2c/c/ssytf2.c index 89f116c27..2bb6fdc1f 100644 --- a/src/map/lapack2flamec/f2c/c/ssytf2.c +++ b/src/map/lapack2flamec/f2c/c/ssytf2.c @@ -212,7 +212,7 @@ int ssytf2_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, intege int sswap_(integer *, real *, integer *, real *, integer *); real absakk; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real colmax; extern logical sisnan_(real *); @@ -246,6 +246,7 @@ int ssytf2_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, intege /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -261,7 +262,7 @@ int ssytf2_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTF2", &i__1); + xerbla_("SSYTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytf2_rk.c b/src/map/lapack2flamec/f2c/c/ssytf2_rk.c index 54eb3ff2a..27637e725 100644 --- a/src/map/lapack2flamec/f2c/c/ssytf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/ssytf2_rk.c @@ -265,7 +265,7 @@ int ssytf2_rk_(char *uplo, integer *n, real *a, integer * lda, real *e, integer real absakk; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real colmax, rowmax; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -298,6 +298,8 @@ int ssytf2_rk_(char *uplo, integer *n, real *a, integer * lda, real *e, integer /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -313,7 +315,7 @@ int ssytf2_rk_(char *uplo, integer *n, real *a, integer * lda, real *e, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTF2_RK", &i__1); + xerbla_("SSYTF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytf2_rook.c b/src/map/lapack2flamec/f2c/c/ssytf2_rook.c index 2a0f2fac6..fa8e1b0e4 100644 --- a/src/map/lapack2flamec/f2c/c/ssytf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssytf2_rook.c @@ -215,7 +215,7 @@ int ssytf2_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, real absakk; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real colmax, rowmax; /* -- LAPACK computational routine (version 3.5.0) -- */ @@ -247,6 +247,8 @@ int ssytf2_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -262,7 +264,7 @@ int ssytf2_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTF2_ROOK", &i__1); + xerbla_("SSYTF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrd_2stage.c b/src/map/lapack2flamec/f2c/c/ssytrd_2stage.c index 13be11795..e5eb76474 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssytrd_2stage.c @@ -237,9 +237,9 @@ int ssytrd_2stage_(char *vect, char *uplo, integer *n, real *a, integer *lda, re int ssytrd_sb2st_(char *, char *, char *, integer *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, integer *), ssytrd_sy2sb_(char *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *); extern logical lsame_(char *, char *); integer abpos, lhmin, lwmin; - logical wantq, upper; + logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -270,7 +270,6 @@ int ssytrd_2stage_(char *vect, char *uplo, integer *n, real *a, integer *lda, re --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "V"); upper = lsame_(uplo, "U"); lquery = *lwork == -1 || *lhous2 == -1; /* Determine the block size, the workspace size and the hous size. */ @@ -312,7 +311,7 @@ int ssytrd_2stage_(char *vect, char *uplo, integer *n, real *a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD_2STAGE", &i__1); + xerbla_("SSYTRD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -337,7 +336,7 @@ int ssytrd_2stage_(char *vect, char *uplo, integer *n, real *a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD_SY2SB", &i__1); + xerbla_("SSYTRD_SY2SB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -345,7 +344,7 @@ int ssytrd_2stage_(char *vect, char *uplo, integer *n, real *a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD_SB2ST", &i__1); + xerbla_("SSYTRD_SB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrd_sb2st.c b/src/map/lapack2flamec/f2c/c/ssytrd_sb2st.c index c7ac7c91f..ebc8a27c6 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrd_sb2st.c +++ b/src/map/lapack2flamec/f2c/c/ssytrd_sb2st.c @@ -1,6 +1,9 @@ /* ../netlib/v3.9.0/ssytrd_sb2st.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#ifdef FLA_OPENMP_MULTITHREADING +#include +#endif static integer c__2 = 2; static integer c_n1 = -1; static integer c__3 = 3; @@ -64,7 +67,7 @@ static real c_b26 = 0.f; /* > VECT is CHARACTER*1 */ /* > = 'N': No need for the Housholder representation, */ /* > and thus LHOUS is of size fla_max(1, 4*N); -*/ + */ /* > = 'V': the Householder representation is needed to */ /* > either generate or to apply Q later on, */ /* > then LHOUS is to be queried and computed. */ @@ -75,7 +78,7 @@ static real c_b26 = 0.f; /* > \verbatim */ /* > UPLO is CHARACTER*1 */ /* > = 'U': Upper triangle of A is stored; -*/ + */ /* > = 'L': Lower triangle of A is stored. */ /* > \endverbatim */ /* > */ @@ -100,7 +103,7 @@ static real c_b26 = 0.f; /* > j-th column of A is stored in the j-th column of the array AB */ /* > as follows: */ /* > if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for fla_max(1,j-kd)<=i<=j; -*/ + */ /* > if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=fla_min(n,j+kd). */ /* > On exit, the diagonal elements of AB are overwritten by the */ /* > diagonal elements of the tridiagonal matrix T; @@ -232,31 +235,35 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_5); #if LF_AOCL_DTL_LOG_ENABLE char buffer[256]; - snprintf(buffer, 256,"ssytrd_sb2st inputs: stage1 %c, vect %c, uplo %c, n %" FLA_IS ", kd %" FLA_IS ", ldab %" FLA_IS ", lhous %" FLA_IS "",*stage1, *vect, *uplo, *n, *kd, *ldab, *lhous); + snprintf(buffer, 256, "ssytrd_sb2st inputs: stage1 %c, vect %c, uplo %c, n %" FLA_IS ", kd %" FLA_IS ", ldab %" FLA_IS ", lhous %" FLA_IS "", *stage1, *vect, *uplo, *n, *kd, *ldab, *lhous); AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ integer ab_dim1, ab_offset, i__1, i__2, i__3, i__4, i__5; /* Local variables */ - integer abofdpos, nthreads, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv, stt, inda; + integer abofdpos, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv, stt, inda; extern integer ilaenv2stage_(integer *, char *, char *, integer *, integer *, integer *, integer *); - integer thed, indv, myid, indw, apos, dpos, edind, debug; + integer thed, indv, myid, indw, apos, dpos, edind; extern logical lsame_(char *, char *); integer lhmin, sizea, shift, stind, colpt, lwmin, awpos; logical wantq, upper; - integer sisev, grsiz, ttype, abdpos; + integer grsiz, ttype, abdpos; extern /* Subroutine */ - int xerbla_(char *, integer *); + int + xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer thgrid, thgrnb, indtau, ofdpos; extern /* Subroutine */ - int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), ssb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *); + int + slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), + slaset_(char *, integer *, integer *, real *, real *, real *, integer *), ssb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *); +#ifdef FLA_OPENMP_MULTITHREADING + extern /* Function */ + int fla_thread_get_num_threads(); +#endif logical lquery, afters1; - extern /* Subroutine */ - int f90_exit_(void); integer ceiltmp, sweepid, nbtiles, sizetau, thgrsiz; - /* #if defined(_OPENMP) */ - /* use omp_lib */ - /* #endif */ + int nthreads; + /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -288,7 +295,6 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, --hous; --work; /* Function Body */ - debug = 0; *info = 0; afters1 = lsame_(stage1, "Y"); wantq = lsame_(vect, "V"); @@ -298,15 +304,15 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ib = ilaenv2stage_(&c__2, "SSYTRD_SB2ST", vect, n, kd, &c_n1, &c_n1); lhmin = ilaenv2stage_(&c__3, "SSYTRD_SB2ST", vect, n, kd, &ib, &c_n1); lwmin = ilaenv2stage_(&c__4, "SSYTRD_SB2ST", vect, n, kd, &ib, &c_n1); - if (! afters1 && ! lsame_(stage1, "N")) + if (!afters1 && !lsame_(stage1, "N")) { *info = -1; } - else if (! lsame_(vect, "N")) + else if (!lsame_(vect, "N")) { *info = -2; } - else if (! upper && ! lsame_(uplo, "L")) + else if (!upper && !lsame_(uplo, "L")) { *info = -3; } @@ -322,23 +328,23 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { *info = -7; } - else if (*lhous < lhmin && ! lquery) + else if (*lhous < lhmin && !lquery) { *info = -11; } - else if (*lwork < lwmin && ! lquery) + else if (*lwork < lwmin && !lquery) { *info = -13; } if (*info == 0) { - hous[1] = (real) lhmin; - work[1] = (real) lwmin; + hous[1] = (real)lhmin; + work[1] = (real)lwmin; } if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD_SB2ST", &i__1); + xerbla_("SSYTRD_SB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -358,14 +364,12 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, /* Determine pointer position */ ldv = *kd + ib; sizetau = *n << 1; - sisev = *n << 1; indtau = 1; indv = indtau + sizetau; lda = (*kd << 1) + 1; sizea = lda * *n; inda = 1; indw = inda + sizea; - nthreads = 1; tid = 0; if (upper) { @@ -394,16 +398,16 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = ab[abdpos + i__ * ab_dim1]; /* L30: */ } i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = 0.f; /* L40: */ @@ -426,8 +430,8 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = ab[abdpos + i__ * ab_dim1]; /* L50: */ @@ -436,8 +440,8 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = ab[abofdpos + (i__ + 1) * ab_dim1]; /* L60: */ @@ -447,8 +451,8 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = ab[abofdpos + i__ * ab_dim1]; /* L70: */ @@ -486,137 +490,137 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ++thgrnb; } i__1 = *kd + 1; - slacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda) ; + slacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda); slaset_("A", kd, n, &c_b26, &c_b26, &work[awpos], &lda); + + nthreads = 1; /* openMP parallelisation start here */ - /* #if defined(_OPENMP) */ - /* !$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND ) */ - /* !$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) */ - /* !$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND ) */ - /* !$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK) */ - /* !$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA ) */ - /* !$OMP$ SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT ) */ - /* !$OMP MASTER */ - /* #endif */ - /* main bulge chasing loop */ - i__1 = thgrnb; - for (thgrid = 1; - thgrid <= i__1; - ++thgrid) +#ifdef FLA_OPENMP_MULTITHREADING + nthreads = fla_thread_get_num_threads(); +#pragma omp parallel num_threads(nthreads) private(tid, thgrid, blklastind) \ + private(thed, i__, m, k, st, ed, stt, sweepid, myid, ttype, colpt, stind, edind) \ + shared(uplo, wantq, indv, indtau, hous, work, \ + n, kd, ib, nbtiles, lda, ldv, inda, stepercol, thgrnb, thgrsiz, grsiz, shift) { - stt = (thgrid - 1) * thgrsiz + 1; - /* Computing MIN */ - i__2 = stt + thgrsiz - 1; - i__3 = *n - 1; // , expr subst - thed = fla_min(i__2,i__3); - i__2 = *n - 1; - for (i__ = stt; - i__ <= i__2; - ++i__) +#pragma omp master { - ed = fla_min(i__,thed); - if (stt > ed) - { - break; - } - i__3 = stepercol; - for (m = 1; - m <= i__3; - ++m) +#endif + /* main bulge chasing loop */ + i__1 = thgrnb; + for (thgrid = 1; + thgrid <= i__1; + ++thgrid) { - st = stt; - i__4 = ed; - for (sweepid = st; - sweepid <= i__4; - ++sweepid) + stt = (thgrid - 1) * thgrsiz + 1; + /* Computing MIN */ + i__2 = stt + thgrsiz - 1; + i__3 = *n - 1; // , expr subst + thed = fla_min(i__2, i__3); + i__2 = *n - 1; + for (i__ = stt; + i__ <= i__2; + ++i__) { - i__5 = grsiz; - for (k = 1; - k <= i__5; - ++k) + ed = fla_min(i__, thed); + if (stt > ed) { - myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; - if (myid == 1) - { - ttype = 1; - } - else - { - ttype = myid % 2 + 2; - } - if (ttype == 2) - { - colpt = myid / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - blklastind = colpt; - } - else + break; + } + i__3 = stepercol; + for (m = 1; + m <= i__3; + ++m) + { + st = stt; + i__4 = ed; + for (sweepid = st; + sweepid <= i__4; + ++sweepid) { - colpt = (myid + 1) / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - if (stind >= edind - 1 && edind == *n) + i__5 = grsiz; + for (k = 1; + k <= i__5; + ++k) { - blklastind = *n; - } - else - { - blklastind = 0; + myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; + if (myid == 1) + { + ttype = 1; + } + else + { + ttype = myid % 2 + 2; + } + if (ttype == 2) + { + colpt = myid / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + blklastind = colpt; + } + else + { + colpt = (myid + 1) / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + if (stind >= edind - 1 && edind == *n) + { + blklastind = *n; + } + else + { + blklastind = 0; + } + } + /* Call the kernel */ +#ifdef FLA_OPENMP_MULTITHREADING + if (ttype != 1) + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(in : work[myid - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + ssb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } + else + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + ssb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } +#else + ssb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); +#endif + if (blklastind >= *n - 1) + { + ++stt; + break; + } + /* L140: */ } + /* L130: */ } - /* Call the kernel */ - /* #if defined(_OPENMP) */ - /* IF( TTYPE.NE.1 ) THEN */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(in:WORK(MYID-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ELSE */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ENDIF */ - /* #else */ - ssb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, & hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); - /* #endif */ - if (blklastind >= *n - 1) - { - ++stt; - break; - } - /* L140: */ + /* L120: */ } - /* L130: */ + /* L110: */ } - /* L120: */ + /* L100: */ } - /* L110: */ - } - /* L100: */ - } - /* #if defined(_OPENMP) */ - /* !$OMP END MASTER */ - /* !$OMP END PARALLEL */ - /* #endif */ +#ifdef FLA_OPENMP_MULTITHREADING + } /* End OMP Master */ + } /* End OMP Parallel */ +#endif /* Copy the diagonal from A to D. Note that D is REAL thus only */ /* the Real part is needed, the imaginary part should be zero. */ i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { d__[i__] = work[dpos + (i__ - 1) * lda]; /* L150: */ @@ -627,8 +631,8 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = work[ofdpos + i__ * lda]; /* L160: */ @@ -638,18 +642,17 @@ int ssytrd_sb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = work[ofdpos + (i__ - 1) * lda]; /* L170: */ } } - hous[1] = (real) lhmin; - work[1] = (real) lwmin; + hous[1] = (real)lhmin; + work[1] = (real)lwmin; AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; /* End of SSYTRD_SB2ST */ } /* ssytrd_sb2st__ */ - diff --git a/src/map/lapack2flamec/f2c/c/ssytrd_sy2sb.c b/src/map/lapack2flamec/f2c/c/ssytrd_sy2sb.c index 8f7c61698..37c1aeedd 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrd_sy2sb.c +++ b/src/map/lapack2flamec/f2c/c/ssytrd_sy2sb.c @@ -261,7 +261,7 @@ int ssytrd_sy2sb_(char *uplo, integer *n, integer *kd, real *a, integer *lda, re integer lwmin; logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), ssymm_(char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), ssyr2k_(char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *), sgelqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), ssymm_(char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), ssyr2k_(char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgelqf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *), slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -332,7 +332,7 @@ int ssytrd_sy2sb_(char *uplo, integer *n, integer *kd, real *a, integer *lda, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD_SY2SB", &i__1); + xerbla_("SSYTRD_SY2SB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrf.c b/src/map/lapack2flamec/f2c/c/ssytrf.c index 102821f55..3e6bddb93 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrf.c +++ b/src/map/lapack2flamec/f2c/c/ssytrf.c @@ -190,7 +190,7 @@ int ssytrf_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int ssytf2_(char *, integer *, real *, integer *, integer *, integer *), xerbla_(char *, integer *); + int ssytf2_(char *, integer *, real *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slasyf_(char *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *); @@ -251,7 +251,7 @@ int ssytrf_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRF", &i__1); + xerbla_("SSYTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrf_aa.c b/src/map/lapack2flamec/f2c/c/ssytrf_aa.c index cdb2ba3e1..6688dc395 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/ssytrf_aa.c @@ -142,7 +142,7 @@ int ssytrf_aa_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, re int sscal_(integer *, real *, real *, integer *), sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -207,7 +207,7 @@ int ssytrf_aa_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, re if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRF_AA", &i__1); + xerbla_("SSYTRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/ssytrf_aa_2stage.c index 3042cb890..dfde771ed 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssytrf_aa_2stage.c @@ -175,7 +175,7 @@ int ssytrf_aa_2stage_(char *uplo, integer *n, real *a, integer *lda, real *tb, i int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgbtrf_(integer *, integer *, integer *, integer *, real *, integer *, integer *, integer *), sgetrf_( integer *, integer *, real *, integer *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -238,7 +238,7 @@ int ssytrf_aa_2stage_(char *uplo, integer *n, real *a, integer *lda, real *tb, i if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRF_AA_2STAGE", &i__1); + xerbla_("SSYTRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrf_rk.c b/src/map/lapack2flamec/f2c/c/ssytrf_rk.c index 0e365f393..ceacde2a7 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/ssytrf_rk.c @@ -269,7 +269,7 @@ int ssytrf_rk_(char *uplo, integer *n, real *a, integer * lda, real *e, integer integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -329,7 +329,7 @@ int ssytrf_rk_(char *uplo, integer *n, real *a, integer * lda, real *e, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRF_RK", &i__1); + xerbla_("SSYTRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrf_rook.c b/src/map/lapack2flamec/f2c/c/ssytrf_rook.c index 34b4e335a..6d2dffdc8 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssytrf_rook.c @@ -216,7 +216,7 @@ int ssytrf_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -278,7 +278,7 @@ int ssytrf_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRF_ROOK", &i__1); + xerbla_("SSYTRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri.c b/src/map/lapack2flamec/f2c/c/ssytri.c index ead2233bf..fa9622968 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri.c +++ b/src/map/lapack2flamec/f2c/c/ssytri.c @@ -130,7 +130,7 @@ int ssytri_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * integer kstep; logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -176,7 +176,7 @@ int ssytri_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI", &i__1); + xerbla_("SSYTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri2.c b/src/map/lapack2flamec/f2c/c/ssytri2.c index a76836e5f..fb556bb2c 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri2.c +++ b/src/map/lapack2flamec/f2c/c/ssytri2.c @@ -137,7 +137,7 @@ int ssytri2_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical lquery; extern /* Subroutine */ @@ -200,7 +200,7 @@ int ssytri2_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI2", &i__1); + xerbla_("SSYTRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri2x.c b/src/map/lapack2flamec/f2c/c/ssytri2x.c index 8265c7702..2ca18bdc4 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri2x.c +++ b/src/map/lapack2flamec/f2c/c/ssytri2x.c @@ -142,7 +142,7 @@ int ssytri2x_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); real u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), strtri_( char *, char *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), strtri_( char *, char *, integer *, real *, integer *, integer *); real u01_ip1_j__, u11_ip1_j__; extern /* Subroutine */ int ssyconv_(char *, char *, integer *, real *, integer *, integer *, real *, integer *); @@ -194,7 +194,7 @@ int ssytri2x_(char *uplo, integer *n, real *a, integer *lda, integer *ipiv, real if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI2X", &i__1); + xerbla_("SSYTRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri_3.c b/src/map/lapack2flamec/f2c/c/ssytri_3.c index 30010042b..48b92c824 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri_3.c +++ b/src/map/lapack2flamec/f2c/c/ssytri_3.c @@ -180,7 +180,7 @@ int ssytri_3_(char *uplo, integer *n, real *a, integer *lda, real *e, integer *i extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -239,7 +239,7 @@ int ssytri_3_(char *uplo, integer *n, real *a, integer *lda, real *e, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI_3", &i__1); + xerbla_("SSYTRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri_3x.c b/src/map/lapack2flamec/f2c/c/ssytri_3x.c index d9a87a764..f54b16d35 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri_3x.c +++ b/src/map/lapack2flamec/f2c/c/ssytri_3x.c @@ -180,7 +180,7 @@ int ssytri_3x_(char *uplo, integer *n, real *a, integer * lda, real *e, integer int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ); real u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int strtri_(char *, char *, integer *, real *, integer *, integer *); @@ -234,7 +234,7 @@ int ssytri_3x_(char *uplo, integer *n, real *a, integer * lda, real *e, integer if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI_3X", &i__1); + xerbla_("SSYTRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytri_rook.c b/src/map/lapack2flamec/f2c/c/ssytri_rook.c index 1b07188a3..c60b3043b 100644 --- a/src/map/lapack2flamec/f2c/c/ssytri_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssytri_rook.c @@ -144,7 +144,7 @@ int ssytri_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, integer kstep; logical upper; extern /* Subroutine */ - int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int scopy_(integer *, real *, integer *, real *, integer *), sswap_(integer *, real *, integer *, real *, integer * ), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -190,7 +190,7 @@ int ssytri_rook_(char *uplo, integer *n, real *a, integer * lda, integer *ipiv, if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRI_ROOK", &i__1); + xerbla_("SSYTRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs.c b/src/map/lapack2flamec/f2c/c/ssytrs.c index 3e97dee90..531b02ecc 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs.c @@ -136,7 +136,7 @@ int ssytrs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, intege int sscal_(integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -191,7 +191,7 @@ int ssytrs_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, intege if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS", &i__1); + xerbla_("SSYTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs2.c b/src/map/lapack2flamec/f2c/c/ssytrs2.c index 33ec955e7..5105f7a12 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs2.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs2.c @@ -143,7 +143,7 @@ int ssytrs2_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, integ int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), ssyconv_(char *, char *, integer *, real *, integer *, integer *, real *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), ssyconv_(char *, char *, integer *, real *, integer *, integer *, real *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -199,7 +199,7 @@ int ssytrs2_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, integ if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS2", &i__1); + xerbla_("SSYTRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs_3.c b/src/map/lapack2flamec/f2c/c/ssytrs_3.c index 38199a55e..5e0be52d5 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs_3.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs_3.c @@ -176,7 +176,7 @@ int ssytrs_3_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, rea int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -232,7 +232,7 @@ int ssytrs_3_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS_3", &i__1); + xerbla_("SSYTRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs_aa.c b/src/map/lapack2flamec/f2c/c/ssytrs_aa.c index ae6cdf71d..c87aa24c2 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs_aa.c @@ -135,7 +135,7 @@ int ssytrs_aa_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, in extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), sgtsv_(integer *, integer *, real *, real *, real *, real *, integer *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), sgtsv_(integer *, integer *, real *, real *, real *, real *, integer *, integer *), strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -203,7 +203,7 @@ int ssytrs_aa_(char *uplo, integer *n, integer *nrhs, real * a, integer *lda, in if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS_AA", &i__1); + xerbla_("SSYTRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/ssytrs_aa_2stage.c index ca732894f..2258f6448 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs_aa_2stage.c @@ -145,7 +145,7 @@ int ssytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, real *a, integer *l extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *), slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len), sgbtrs_(char *, integer *, integer *, integer *, integer *, real *, integer *, integer *, real *, integer *, integer *), slaswp_(integer *, real *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int ssytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS_AA_2STAGE", &i__1); + xerbla_("SSYTRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ssytrs_rook.c b/src/map/lapack2flamec/f2c/c/ssytrs_rook.c index 4b7ed8753..4df55a585 100644 --- a/src/map/lapack2flamec/f2c/c/ssytrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/ssytrs_rook.c @@ -150,7 +150,7 @@ int ssytrs_rook_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, i int sscal_(integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int ssytrs_rook_(char *uplo, integer *n, integer *nrhs, real *a, integer *lda, i if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRS_ROOK", &i__1); + xerbla_("SSYTRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stbcon.c b/src/map/lapack2flamec/f2c/c/stbcon.c index 1c335c0ae..d8dedeb78 100644 --- a/src/map/lapack2flamec/f2c/c/stbcon.c +++ b/src/map/lapack2flamec/f2c/c/stbcon.c @@ -159,7 +159,7 @@ int stbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, real *a int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); extern real slantb_(char *, char *, char *, integer *, integer *, real *, integer *, real *); real ainvnm; @@ -230,7 +230,7 @@ int stbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("STBCON", &i__1); + xerbla_("STBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stbrfs.c b/src/map/lapack2flamec/f2c/c/stbrfs.c index 695aaf009..7d5835030 100644 --- a/src/map/lapack2flamec/f2c/c/stbrfs.c +++ b/src/map/lapack2flamec/f2c/c/stbrfs.c @@ -205,7 +205,7 @@ int stbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -291,7 +291,7 @@ int stbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STBRFS", &i__1); + xerbla_("STBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stbtrs.c b/src/map/lapack2flamec/f2c/c/stbtrs.c index fda1cb955..0621a93ff 100644 --- a/src/map/lapack2flamec/f2c/c/stbtrs.c +++ b/src/map/lapack2flamec/f2c/c/stbtrs.c @@ -151,7 +151,7 @@ int stbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int stbsv_(char *, char *, char *, integer *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -220,7 +220,7 @@ int stbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STBTRS", &i__1); + xerbla_("STBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stfsm.c b/src/map/lapack2flamec/f2c/c/stfsm.c index 43a52c93d..b344c0f51 100644 --- a/src/map/lapack2flamec/f2c/c/stfsm.c +++ b/src/map/lapack2flamec/f2c/c/stfsm.c @@ -279,7 +279,7 @@ int stfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege int sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); logical lower; extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical misodd, nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -348,7 +348,7 @@ int stfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege if (info != 0) { i__1 = -info; - xerbla_("STFSM ", &i__1); + xerbla_("STFSM ", &i__1, (ftnlen)6); return 0; } /* Quick return when ( (N.EQ.0).OR.(M.EQ.0) ) */ diff --git a/src/map/lapack2flamec/f2c/c/stftri.c b/src/map/lapack2flamec/f2c/c/stftri.c index 13c503b6d..97b19e967 100644 --- a/src/map/lapack2flamec/f2c/c/stftri.c +++ b/src/map/lapack2flamec/f2c/c/stftri.c @@ -207,7 +207,7 @@ int stftri_(char *transr, char *uplo, char *diag, integer *n, real *a, integer * extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strmm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int strtri_(char *, char *, integer *, real *, integer *, integer *); @@ -254,7 +254,7 @@ int stftri_(char *transr, char *uplo, char *diag, integer *n, real *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("STFTRI", &i__1); + xerbla_("STFTRI", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/stfttp.c b/src/map/lapack2flamec/f2c/c/stfttp.c index a1551adae..10e445f66 100644 --- a/src/map/lapack2flamec/f2c/c/stfttp.c +++ b/src/map/lapack2flamec/f2c/c/stfttp.c @@ -182,12 +182,12 @@ int stfttp_(char *transr, char *uplo, integer *n, real *arf, real *ap, integer * /* System generated locals */ integer i__1, i__2, i__3; /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -226,7 +226,7 @@ int stfttp_(char *transr, char *uplo, integer *n, real *arf, real *ap, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("STFTTP", &i__1); + xerbla_("STFTTP", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -247,7 +247,6 @@ int stfttp_(char *transr, char *uplo, integer *n, real *arf, real *ap, integer * return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/stfttr.c b/src/map/lapack2flamec/f2c/c/stfttr.c index a293ea75a..8302da128 100644 --- a/src/map/lapack2flamec/f2c/c/stfttr.c +++ b/src/map/lapack2flamec/f2c/c/stfttr.c @@ -193,7 +193,7 @@ int stfttr_(char *transr, char *uplo, integer *n, real *arf, real *a, integer *l extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -242,7 +242,7 @@ int stfttr_(char *transr, char *uplo, integer *n, real *arf, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("STFTTR", &i__1); + xerbla_("STFTTR", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/stgevc.c b/src/map/lapack2flamec/f2c/c/stgevc.c index 92763422f..e7e68bfed 100644 --- a/src/map/lapack2flamec/f2c/c/stgevc.c +++ b/src/map/lapack2flamec/f2c/c/stgevc.c @@ -340,7 +340,7 @@ int stgevc_(char *side, char *howmny, logical *select, integer *n, real *s, inte extern real slamch_(char *); real salfar, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real xscale, bignum; logical ilcomp, ilcplx; extern /* Subroutine */ @@ -385,6 +385,7 @@ int stgevc_(char *side, char *howmny, logical *select, integer *n, real *s, inte vr -= vr_offset; --work; /* Function Body */ + ilback = FALSE_; if (lsame_(howmny, "A")) { ihwmny = 1; @@ -454,7 +455,7 @@ int stgevc_(char *side, char *howmny, logical *select, integer *n, real *s, inte if (*info != 0) { i__1 = -(*info); - xerbla_("STGEVC", &i__1); + xerbla_("STGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -549,7 +550,7 @@ int stgevc_(char *side, char *howmny, logical *select, integer *n, real *s, inte if (*info != 0) { i__1 = -(*info); - xerbla_("STGEVC", &i__1); + xerbla_("STGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgexc.c b/src/map/lapack2flamec/f2c/c/stgexc.c index 1b5994337..478af2c4c 100644 --- a/src/map/lapack2flamec/f2c/c/stgexc.c +++ b/src/map/lapack2flamec/f2c/c/stgexc.c @@ -226,7 +226,7 @@ int stgexc_(logical *wantq, logical *wantz, integer *n, real *a, integer *lda, r /* Local variables */ integer nbf, nbl, here, lwmin; extern /* Subroutine */ - int stgex2_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, real *, integer *, integer *), xerbla_(char *, integer *); + int stgex2_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer nbnext; logical lquery; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -312,7 +312,7 @@ int stgexc_(logical *wantq, logical *wantz, integer *n, real *a, integer *lda, r if (*info != 0) { i__1 = -(*info); - xerbla_("STGEXC", &i__1); + xerbla_("STGEXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgsen.c b/src/map/lapack2flamec/f2c/c/stgsen.c index 73b549393..a2ea00dc0 100644 --- a/src/map/lapack2flamec/f2c/c/stgsen.c +++ b/src/map/lapack2flamec/f2c/c/stgsen.c @@ -483,7 +483,7 @@ int stgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte real dscale, rdscal; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ), stgexc_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ), stgexc_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *); integer liwmin; extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *, real *); @@ -564,7 +564,7 @@ int stgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("STGSEN", &i__1); + xerbla_("STGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } @@ -668,7 +668,7 @@ int stgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("STGSEN", &i__1); + xerbla_("STGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgsja.c b/src/map/lapack2flamec/f2c/c/stgsja.c index 147d29fb1..f26e936bb 100644 --- a/src/map/lapack2flamec/f2c/c/stgsja.c +++ b/src/map/lapack2flamec/f2c/c/stgsja.c @@ -406,7 +406,7 @@ int stgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer int scopy_(integer *, real *, integer *, real *, integer *), slags2_(logical *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *); integer kcycle; extern /* Subroutine */ - int xerbla_(char *, integer *), slapll_( integer *, real *, integer *, real *, integer *, real *), slartg_( real *, real *, real *, real *, real *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slapll_( integer *, real *, integer *, real *, integer *, real *), slartg_( real *, real *, real *, real *, real *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); real hugenum; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -503,7 +503,7 @@ int stgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("STGSJA", &i__1); + xerbla_("STGSJA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgsna.c b/src/map/lapack2flamec/f2c/c/stgsna.c index 16462d768..ca6cc2dfa 100644 --- a/src/map/lapack2flamec/f2c/c/stgsna.c +++ b/src/map/lapack2flamec/f2c/c/stgsna.c @@ -421,7 +421,7 @@ int stgsna_(char *job, char *howmny, logical *select, integer *n, real *a, integ real dummy1[1], alphai, alphar; extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical wantbh, wantdf; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), stgexc_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *); @@ -478,6 +478,7 @@ int stgsna_(char *job, char *howmny, logical *select, integer *n, real *a, integ somcon = lsame_(howmny, "S"); *info = 0; lquery = *lwork == -1; + cond = 0.f; if (! wants && ! wantdf) { *info = -1; @@ -583,7 +584,7 @@ int stgsna_(char *job, char *howmny, logical *select, integer *n, real *a, integ if (*info != 0) { i__1 = -(*info); - xerbla_("STGSNA", &i__1); + xerbla_("STGSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgsy2.c b/src/map/lapack2flamec/f2c/c/stgsy2.c index 792b2c649..697d9166d 100644 --- a/src/map/lapack2flamec/f2c/c/stgsy2.c +++ b/src/map/lapack2flamec/f2c/c/stgsy2.c @@ -289,7 +289,7 @@ int stgsy2_(char *trans, integer *ijob, integer *m, integer * n, real *a, intege int sscal_(integer *, real *, real *, integer *), sgemm_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), sgesc2_(integer *, real *, integer *, real *, integer *, integer *, real *), sgetc2_(integer *, real *, integer *, integer *, integer *, integer *); real scaloc; extern /* Subroutine */ - int slatdf_(integer *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); + int slatdf_(integer *, integer *, real *, integer *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); logical notran; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -389,7 +389,7 @@ int stgsy2_(char *trans, integer *ijob, integer *m, integer * n, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STGSY2", &i__1); + xerbla_("STGSY2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stgsyl.c b/src/map/lapack2flamec/f2c/c/stgsyl.c index 37a265d7d..890748079 100644 --- a/src/map/lapack2flamec/f2c/c/stgsyl.c +++ b/src/map/lapack2flamec/f2c/c/stgsyl.c @@ -320,7 +320,7 @@ int stgsyl_(char *trans, integer *ijob, integer *m, integer * n, real *a, intege int stgsy2_(char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *, integer *); real scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *); @@ -376,6 +376,7 @@ int stgsyl_(char *trans, integer *ijob, integer *m, integer * n, real *a, intege *info = 0; notran = lsame_(trans, "N"); lquery = *lwork == -1; + scale2 = 0.f; if (! notran && ! lsame_(trans, "T")) { *info = -1; @@ -451,7 +452,7 @@ int stgsyl_(char *trans, integer *ijob, integer *m, integer * n, real *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STGSYL", &i__1); + xerbla_("STGSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpcon.c b/src/map/lapack2flamec/f2c/c/stpcon.c index 1b201a672..d414b5d4f 100644 --- a/src/map/lapack2flamec/f2c/c/stpcon.c +++ b/src/map/lapack2flamec/f2c/c/stpcon.c @@ -146,7 +146,7 @@ int stpcon_(char *norm, char *uplo, char *diag, integer *n, real *ap, real *rcon int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; logical onenrm; @@ -207,7 +207,7 @@ int stpcon_(char *norm, char *uplo, char *diag, integer *n, real *ap, real *rcon if (*info != 0) { i__1 = -(*info); - xerbla_("STPCON", &i__1); + xerbla_("STPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stplqt.c b/src/map/lapack2flamec/f2c/c/stplqt.c index 2cf2f5e21..bda2cb847 100644 --- a/src/map/lapack2flamec/f2c/c/stplqt.c +++ b/src/map/lapack2flamec/f2c/c/stplqt.c @@ -189,7 +189,7 @@ int stplqt_(integer *m, integer *n, integer *l, integer *mb, real *a, integer *l /* Local variables */ integer i__, ib, lb, nb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stplqt2_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stplqt2_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -250,7 +250,7 @@ int stplqt_(integer *m, integer *n, integer *l, integer *mb, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("STPLQT", &i__1); + xerbla_("STPLQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stplqt2.c b/src/map/lapack2flamec/f2c/c/stplqt2.c index fae436e75..b105a91c4 100644 --- a/src/map/lapack2flamec/f2c/c/stplqt2.c +++ b/src/map/lapack2flamec/f2c/c/stplqt2.c @@ -184,7 +184,7 @@ int stplqt2_(integer *m, integer *n, integer *l, real *a, integer *lda, real *b, int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *); real alpha; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -243,7 +243,7 @@ int stplqt2_(integer *m, integer *n, integer *l, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("STPLQT2", &i__1); + xerbla_("STPLQT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpmlqt.c b/src/map/lapack2flamec/f2c/c/stpmlqt.c index 2faac3822..d75000604 100644 --- a/src/map/lapack2flamec/f2c/c/stpmlqt.c +++ b/src/map/lapack2flamec/f2c/c/stpmlqt.c @@ -224,7 +224,7 @@ int stpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); logical notran; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -321,7 +321,7 @@ int stpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STPMLQT", &i__1); + xerbla_("STPMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpmqrt.c b/src/map/lapack2flamec/f2c/c/stpmqrt.c index 98255c5e4..00dd2feac 100644 --- a/src/map/lapack2flamec/f2c/c/stpmqrt.c +++ b/src/map/lapack2flamec/f2c/c/stpmqrt.c @@ -225,7 +225,7 @@ int stpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); logical notran; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -324,7 +324,7 @@ int stpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STPMQRT", &i__1); + xerbla_("STPMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpqrt.c b/src/map/lapack2flamec/f2c/c/stpqrt.c index e6dd4d0bf..4cb0db218 100644 --- a/src/map/lapack2flamec/f2c/c/stpqrt.c +++ b/src/map/lapack2flamec/f2c/c/stpqrt.c @@ -189,7 +189,7 @@ int stpqrt_(integer *m, integer *n, integer *l, integer *nb, real *a, integer *l /* Local variables */ integer i__, ib, lb, mb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stpqrt2_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), stprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), stpqrt2_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -250,7 +250,7 @@ int stpqrt_(integer *m, integer *n, integer *l, integer *nb, real *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("STPQRT", &i__1); + xerbla_("STPQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpqrt2.c b/src/map/lapack2flamec/f2c/c/stpqrt2.c index 1e5fbf8d8..831f48efe 100644 --- a/src/map/lapack2flamec/f2c/c/stpqrt2.c +++ b/src/map/lapack2flamec/f2c/c/stpqrt2.c @@ -181,7 +181,7 @@ int stpqrt2_(integer *m, integer *n, integer *l, real *a, integer *lda, real *b, int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *); real alpha; extern /* Subroutine */ - int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), strmv_(char *, char *, char *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -240,7 +240,7 @@ int stpqrt2_(integer *m, integer *n, integer *l, real *a, integer *lda, real *b, if (*info != 0) { i__1 = -(*info); - xerbla_("STPQRT2", &i__1); + xerbla_("STPQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stprfs.c b/src/map/lapack2flamec/f2c/c/stprfs.c index 908a9b53e..31271e369 100644 --- a/src/map/lapack2flamec/f2c/c/stprfs.c +++ b/src/map/lapack2flamec/f2c/c/stprfs.c @@ -194,7 +194,7 @@ int stprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -270,7 +270,7 @@ int stprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real if (*info != 0) { i__1 = -(*info); - xerbla_("STPRFS", &i__1); + xerbla_("STPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stptri.c b/src/map/lapack2flamec/f2c/c/stptri.c index 9fc295785..b3146dcf8 100644 --- a/src/map/lapack2flamec/f2c/c/stptri.c +++ b/src/map/lapack2flamec/f2c/c/stptri.c @@ -126,7 +126,7 @@ int stptri_(char *uplo, char *diag, integer *n, real *ap, integer *info) int sscal_(integer *, real *, real *, integer *); logical upper; extern /* Subroutine */ - int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int stpmv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jclast; logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -154,6 +154,7 @@ int stptri_(char *uplo, char *diag, integer *n, real *ap, integer *info) *info = 0; upper = lsame_(uplo, "U"); nounit = lsame_(diag, "N"); + jclast = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -169,7 +170,7 @@ int stptri_(char *uplo, char *diag, integer *n, real *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("STPTRI", &i__1); + xerbla_("STPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stptrs.c b/src/map/lapack2flamec/f2c/c/stptrs.c index a76521c3b..143c86ab2 100644 --- a/src/map/lapack2flamec/f2c/c/stptrs.c +++ b/src/map/lapack2flamec/f2c/c/stptrs.c @@ -136,7 +136,7 @@ int stptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(char *, integer *); + int stpsv_(char *, char *, char *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -195,7 +195,7 @@ int stptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real if (*info != 0) { i__1 = -(*info); - xerbla_("STPTRS", &i__1); + xerbla_("STPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/stpttf.c b/src/map/lapack2flamec/f2c/c/stpttf.c index 58de9a4cd..941314467 100644 --- a/src/map/lapack2flamec/f2c/c/stpttf.c +++ b/src/map/lapack2flamec/f2c/c/stpttf.c @@ -180,12 +180,12 @@ int stpttf_(char *transr, char *uplo, integer *n, real *ap, real *arf, integer * /* System generated locals */ integer i__1, i__2, i__3; /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -225,7 +225,7 @@ int stpttf_(char *transr, char *uplo, integer *n, real *ap, real *arf, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("STPTTF", &i__1); + xerbla_("STPTTF", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -246,7 +246,6 @@ int stpttf_(char *transr, char *uplo, integer *n, real *ap, real *arf, integer * return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/stpttr.c b/src/map/lapack2flamec/f2c/c/stpttr.c index 41ac4848b..a48970c03 100644 --- a/src/map/lapack2flamec/f2c/c/stpttr.c +++ b/src/map/lapack2flamec/f2c/c/stpttr.c @@ -100,7 +100,7 @@ int stpttr_(char *uplo, integer *n, real *ap, real *a, integer *lda, integer *in extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -143,7 +143,7 @@ int stpttr_(char *uplo, integer *n, real *ap, real *a, integer *lda, integer *in if (*info != 0) { i__1 = -(*info); - xerbla_("STPTTR", &i__1); + xerbla_("STPTTR", &i__1, (ftnlen)6); return 0; } if (lower) diff --git a/src/map/lapack2flamec/f2c/c/strcon.c b/src/map/lapack2flamec/f2c/c/strcon.c index 00c983287..0d70eaad9 100644 --- a/src/map/lapack2flamec/f2c/c/strcon.c +++ b/src/map/lapack2flamec/f2c/c/strcon.c @@ -152,7 +152,7 @@ int strcon_(char *norm, char *uplo, char *diag, integer *n, real *a, integer *ld int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer isamax_(integer *, real *, integer *); real ainvnm; logical onenrm; @@ -219,7 +219,7 @@ int strcon_(char *norm, char *uplo, char *diag, integer *n, real *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("STRCON", &i__1); + xerbla_("STRCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strevc.c b/src/map/lapack2flamec/f2c/c/strevc.c index 91f11235c..3cbeb4ead 100644 --- a/src/map/lapack2flamec/f2c/c/strevc.c +++ b/src/map/lapack2flamec/f2c/c/strevc.c @@ -267,7 +267,7 @@ int strevc_(char *side, char *howmny, logical *select, integer *n, real *t, inte int saxpy_(integer *, real *, real *, integer *, real *, integer *), slaln2_(logical *, integer *, integer *, real *, real *, real *, integer *, real *, real *, real *, integer *, real *, real *, real *, integer *, real *, real *, integer *), slabad_(real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; extern integer isamax_(integer *, real *, integer *); logical rightv; @@ -402,7 +402,7 @@ int strevc_(char *side, char *howmny, logical *select, integer *n, real *t, inte if (*info != 0) { i__1 = -(*info); - xerbla_("STREVC", &i__1); + xerbla_("STREVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strevc3.c b/src/map/lapack2flamec/f2c/c/strevc3.c index b79e01d9a..9b654cd33 100644 --- a/src/map/lapack2flamec/f2c/c/strevc3.c +++ b/src/map/lapack2flamec/f2c/c/strevc3.c @@ -250,8 +250,7 @@ int strevc3_(char *side, char *howmny, logical *select, integer *n, real *t, int AOCL_DTL_LOG(AOCL_DTL_LEVEL_TRACE_5, buffer); #endif /* System generated locals */ - address a__1[2]; - integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1[2], i__2, i__3, i__4; + integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__2, i__3, i__4; real r__1, r__2, r__3, r__4; char ch__1[2]; /* Builtin functions */ @@ -291,7 +290,7 @@ int strevc3_(char *side, char *howmny, logical *select, integer *n, real *t, int int saxpy_(integer *, real *, real *, integer *, real *, integer *), slaln2_(logical *, integer *, integer *, real *, real *, real *, integer *, real *, real *, real *, integer *, real *, real *, real *, integer *, real *, real *, integer *), slabad_(real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern integer isamax_(integer *, real *, integer *); @@ -445,7 +444,7 @@ int strevc3_(char *side, char *howmny, logical *select, integer *n, real *t, int if (*info != 0) { i__2 = -(*info); - xerbla_("STREVC3", &i__2); + xerbla_("STREVC3", &i__2, (ftnlen)7); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strexc.c b/src/map/lapack2flamec/f2c/c/strexc.c index a1b4339c4..6bb179b97 100644 --- a/src/map/lapack2flamec/f2c/c/strexc.c +++ b/src/map/lapack2flamec/f2c/c/strexc.c @@ -156,7 +156,7 @@ int strexc_(char *compq, integer *n, real *t, integer *ldt, real *q, integer *ld extern logical lsame_(char *, char *); logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), slaexc_( logical *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, real *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slaexc_( logical *, integer *, real *, integer *, real *, integer *, integer *, integer *, integer *, real *, integer *); integer nbnext; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -217,7 +217,7 @@ int strexc_(char *compq, integer *n, real *t, integer *ldt, real *q, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("STREXC", &i__1); + xerbla_("STREXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strrfs.c b/src/map/lapack2flamec/f2c/c/strrfs.c index cb02cd65c..c68f66fb8 100644 --- a/src/map/lapack2flamec/f2c/c/strrfs.c +++ b/src/map/lapack2flamec/f2c/c/strrfs.c @@ -198,7 +198,7 @@ int strrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real extern real slamch_(char *); real safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transt[1]; logical nounit; @@ -280,7 +280,7 @@ int strrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real if (*info != 0) { i__1 = -(*info); - xerbla_("STRRFS", &i__1); + xerbla_("STRRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strsen.c b/src/map/lapack2flamec/f2c/c/strsen.c index fa4cba0bc..10de44360 100644 --- a/src/map/lapack2flamec/f2c/c/strsen.c +++ b/src/map/lapack2flamec/f2c/c/strsen.c @@ -345,7 +345,7 @@ int strsen_(char *job, char *compq, logical *select, integer *n, real *t, intege int slacn2_(integer *, real *, real *, integer *, real *, integer *, integer *); extern real slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical wantbh; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -397,6 +397,8 @@ int strsen_(char *job, char *compq, logical *select, integer *n, real *t, intege wantq = lsame_(compq, "V"); *info = 0; lquery = *lwork == -1; + liwmin = 0; + lwmin = 0; if (! lsame_(job, "N") && ! wants && ! wantsp) { *info = -1; @@ -500,7 +502,7 @@ int strsen_(char *job, char *compq, logical *select, integer *n, real *t, intege if (*info != 0) { i__1 = -(*info); - xerbla_("STRSEN", &i__1); + xerbla_("STRSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strsna.c b/src/map/lapack2flamec/f2c/c/strsna.c index d30aaf587..2f0ae5264 100644 --- a/src/map/lapack2flamec/f2c/c/strsna.c +++ b/src/map/lapack2flamec/f2c/c/strsna.c @@ -303,7 +303,7 @@ int strsna_(char *job, char *howmny, logical *select, integer *n, real *t, integ int slabad_(real *, real *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical wantbh; extern /* Subroutine */ @@ -447,7 +447,7 @@ int strsna_(char *job, char *howmny, logical *select, integer *n, real *t, integ if (*info != 0) { i__1 = -(*info); - xerbla_("STRSNA", &i__1); + xerbla_("STRSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strsyl.c b/src/map/lapack2flamec/f2c/c/strsyl.c index 18bbdd1cc..382e7968a 100644 --- a/src/map/lapack2flamec/f2c/c/strsyl.c +++ b/src/map/lapack2flamec/f2c/c/strsyl.c @@ -192,7 +192,7 @@ int strsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, rea real scaloc; extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); real bignum; logical notrna, notrnb; real smlnum; @@ -268,7 +268,7 @@ int strsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, rea if (*info != 0) { i__1 = -(*info); - xerbla_("STRSYL", &i__1); + xerbla_("STRSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strsyl3.c b/src/map/lapack2flamec/f2c/c/strsyl3.c index ed419fbf6..7f88610ee 100644 --- a/src/map/lapack2flamec/f2c/c/strsyl3.c +++ b/src/map/lapack2flamec/f2c/c/strsyl3.c @@ -192,11 +192,10 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re /* Builtin functions */ double pow_dd(doublereal *, doublereal *); /* Local variables */ - extern /* Subroutine */ - int f90_cycle_(void); integer i__, j, k, l, i1, i2, j1, j2, k1, k2, l1, l2, nb, pc, jj, ll, nba, nbb; real buf, sgn, scal, anrm, bnrm, cnrm; - integer awrk, bwrk, temp; + integer awrk, bwrk; + int temp; logical skip; real *wnrm, xnrm; extern logical lsame_(char *, char *); @@ -207,7 +206,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); real scamin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); real bignum; extern /* Subroutine */ @@ -322,7 +321,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (*info != 0) { i__1 = -(*info); - xerbla_("STRSYL3", &i__1); + xerbla_("STRSYL3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -574,7 +573,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__2 = nbb; @@ -592,7 +591,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -626,7 +625,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -639,15 +638,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -710,7 +709,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -723,15 +722,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -822,7 +821,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__3 = nbb; @@ -840,7 +839,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -875,7 +874,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__4 = nbb; for (jj = 1; @@ -888,15 +887,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -959,7 +958,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__4 = nbb; for (jj = 1; @@ -972,15 +971,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1070,7 +1069,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__2 = nbb; @@ -1088,7 +1087,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -1123,7 +1122,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -1136,15 +1135,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1207,7 +1206,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__3 = nbb; for (jj = 1; @@ -1220,15 +1219,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1317,7 +1316,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); } i__1 = nbb; @@ -1335,7 +1334,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); @@ -1370,7 +1369,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -1383,15 +1382,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; @@ -1454,7 +1453,7 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re if (scaloc * scamin == 0.f) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b19, &d__1); i__2 = nbb; for (jj = 1; @@ -1467,15 +1466,15 @@ int strsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, re ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; r__1 = bignum; r__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b19, &d__1); // , expr subst swork[ll + jj * swork_dim1] = fla_min(r__1,r__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b19, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b19, &d__1); } cnrm *= scaloc; diff --git a/src/map/lapack2flamec/f2c/c/strtrs.c b/src/map/lapack2flamec/f2c/c/strtrs.c index 4e42d8b01..c27b6b2f5 100644 --- a/src/map/lapack2flamec/f2c/c/strtrs.c +++ b/src/map/lapack2flamec/f2c/c/strtrs.c @@ -142,7 +142,7 @@ int strtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(char *, integer *); + int strsm_(char *, char *, char *, char *, integer *, integer *, real *, real *, integer *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -206,7 +206,7 @@ int strtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, real if (*info != 0) { i__1 = -(*info); - xerbla_("STRTRS", &i__1); + xerbla_("STRTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/strttf.c b/src/map/lapack2flamec/f2c/c/strttf.c index c9cfae15c..b49ce050a 100644 --- a/src/map/lapack2flamec/f2c/c/strttf.c +++ b/src/map/lapack2flamec/f2c/c/strttf.c @@ -191,7 +191,7 @@ int strttf_(char *transr, char *uplo, integer *n, real *a, integer *lda, real *a extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int strttf_(char *transr, char *uplo, integer *n, real *a, integer *lda, real *a if (*info != 0) { i__1 = -(*info); - xerbla_("STRTTF", &i__1); + xerbla_("STRTTF", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/c/strttp.c b/src/map/lapack2flamec/f2c/c/strttp.c index d3ed517a0..3a5909a94 100644 --- a/src/map/lapack2flamec/f2c/c/strttp.c +++ b/src/map/lapack2flamec/f2c/c/strttp.c @@ -100,7 +100,7 @@ int strttp_(char *uplo, integer *n, real *a, integer *lda, real *ap, integer *in extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -143,7 +143,7 @@ int strttp_(char *uplo, integer *n, real *a, integer *lda, real *ap, integer *in if (*info != 0) { i__1 = -(*info); - xerbla_("STRTTP", &i__1); + xerbla_("STRTTP", &i__1, (ftnlen)6); return 0; } if (lower) diff --git a/src/map/lapack2flamec/f2c/c/stzrqf.c b/src/map/lapack2flamec/f2c/c/stzrqf.c index 4999a6557..03d15594b 100644 --- a/src/map/lapack2flamec/f2c/c/stzrqf.c +++ b/src/map/lapack2flamec/f2c/c/stzrqf.c @@ -135,7 +135,7 @@ int stzrqf_(integer *m, integer *n, real *a, integer *lda, real *tau, integer *i /* Local variables */ integer i__, k, m1; extern /* Subroutine */ - int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), xerbla_(char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int sger_(integer *, integer *, real *, real *, integer *, real *, integer *, real *, integer *), sgemv_(char *, integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), scopy_(integer *, real *, integer *, real *, integer *), saxpy_(integer *, real *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -177,7 +177,7 @@ int stzrqf_(integer *m, integer *n, real *a, integer *lda, real *tau, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("STZRQF", &i__1); + xerbla_("STZRQF", &i__1, (ftnlen)6); return 0; } /* Perform the factorization. */ diff --git a/src/map/lapack2flamec/f2c/c/stzrzf.c b/src/map/lapack2flamec/f2c/c/stzrzf.c index a4f7086f0..84fe42fd0 100644 --- a/src/map/lapack2flamec/f2c/c/stzrzf.c +++ b/src/map/lapack2flamec/f2c/c/stzrzf.c @@ -155,7 +155,7 @@ int stzrzf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work /* Local variables */ integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarzb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *); @@ -208,6 +208,7 @@ int stzrzf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work { *info = -4; } + nb = ilaenv_(&c__1, "SGERQF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { if (*m == 0 || *m == *n) @@ -218,7 +219,6 @@ int stzrzf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work else { /* Determine the block size. */ - nb = ilaenv_(&c__1, "SGERQF", " ", m, n, &c_n1, &c_n1); lwkopt = *m * nb; lwkmin = fla_max(1,*m); } @@ -231,7 +231,7 @@ int stzrzf_(integer *m, integer *n, real *a, integer *lda, real *tau, real *work if (*info != 0) { i__1 = -(*info); - xerbla_("STZRZF", &i__1); + xerbla_("STZRZF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_EXIT(AOCL_DTL_LEVEL_TRACE_5); return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zbbcsd.c b/src/map/lapack2flamec/f2c/c/zbbcsd.c index b5ddb13ec..535a50b51 100644 --- a/src/map/lapack2flamec/f2c/c/zbbcsd.c +++ b/src/map/lapack2flamec/f2c/c/zbbcsd.c @@ -369,7 +369,7 @@ int zbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, extern doublereal dlamch_(char *); doublereal sigma11, sigma21; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal thresh, tolmul; logical lquery; doublereal b11bulge, b12bulge; @@ -489,7 +489,7 @@ int zbbcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("ZBBCSD", &i__1); + xerbla_("ZBBCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zbdsqr.c b/src/map/lapack2flamec/f2c/c/zbdsqr.c index ded2c4634..d7c2b2bf8 100644 --- a/src/map/lapack2flamec/f2c/c/zbdsqr.c +++ b/src/map/lapack2flamec/f2c/c/zbdsqr.c @@ -255,7 +255,7 @@ int zbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, int zlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), dlasq1_(integer *, doublereal *, doublereal *, doublereal *, integer *), dlasv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); doublereal sminoa, thresh; logical rotate; doublereal tolmul; @@ -331,7 +331,7 @@ int zbdsqr_(char *uplo, integer *n, integer *ncvt, integer * nru, integer *ncc, if (*info != 0) { i__1 = -(*info); - xerbla_("ZBDSQR", &i__1); + xerbla_("ZBDSQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zcgesv.c b/src/map/lapack2flamec/f2c/c/zcgesv.c index 842ec1c39..bbce9c0de 100644 --- a/src/map/lapack2flamec/f2c/c/zcgesv.c +++ b/src/map/lapack2flamec/f2c/c/zcgesv.c @@ -219,7 +219,7 @@ int zcgesv_(integer *n, integer *nrhs, doublecomplex *a, integer *lda, integer * int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), clag2z_( integer *, integer *, complex *, integer *, doublecomplex *, integer *, integer *), zlag2c_(integer *, integer *, doublecomplex *, integer *, complex *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int cgetrf_(integer *, integer *, complex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int cgetrs_(char *, integer *, integer *, complex *, integer *, integer *, complex *, integer *, integer *); @@ -291,7 +291,7 @@ int zcgesv_(integer *n, integer *nrhs, doublecomplex *a, integer *lda, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZCGESV", &i__1); + xerbla_("ZCGESV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zcposv.c b/src/map/lapack2flamec/f2c/c/zcposv.c index 82fc9ff2b..c4d3e4e0f 100644 --- a/src/map/lapack2flamec/f2c/c/zcposv.c +++ b/src/map/lapack2flamec/f2c/c/zcposv.c @@ -228,7 +228,7 @@ int zcposv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld int zhemm_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zlag2c_(integer *, integer *, doublecomplex *, integer *, complex *, integer *, integer *), clag2z_(integer *, integer *, complex *, integer *, doublecomplex *, integer *, integer *), zlat2c_(char *, integer *, doublecomplex *, integer *, complex *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ @@ -300,7 +300,7 @@ int zcposv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZCPOSV", &i__1); + xerbla_("ZCPOSV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbbrd.c b/src/map/lapack2flamec/f2c/c/zgbbrd.c index ae34365f1..3f35d4f24 100644 --- a/src/map/lapack2flamec/f2c/c/zgbbrd.c +++ b/src/map/lapack2flamec/f2c/c/zgbbrd.c @@ -225,7 +225,7 @@ int zgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ integer minmn; logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *); logical wantpt; extern /* Subroutine */ int zlartv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); @@ -317,7 +317,7 @@ int zgbbrd_(char *vect, integer *m, integer *n, integer *ncc, integer *kl, integ if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBBRD", &i__1); + xerbla_("ZGBBRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbcon.c b/src/map/lapack2flamec/f2c/c/zgbcon.c index fab99b3a2..ac68fedff 100644 --- a/src/map/lapack2flamec/f2c/c/zgbcon.c +++ b/src/map/lapack2flamec/f2c/c/zgbcon.c @@ -161,7 +161,7 @@ int zgbcon_(char *norm, integer *n, integer *kl, integer *ku, doublecomplex *ab, int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zlacn2_( integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); logical onenrm; @@ -233,7 +233,7 @@ int zgbcon_(char *norm, integer *n, integer *kl, integer *ku, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBCON", &i__1); + xerbla_("ZGBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbequ.c b/src/map/lapack2flamec/f2c/c/zgbequ.c index 40738dd44..2c221a597 100644 --- a/src/map/lapack2flamec/f2c/c/zgbequ.c +++ b/src/map/lapack2flamec/f2c/c/zgbequ.c @@ -154,7 +154,7 @@ int zgbequ_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, doublereal rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -212,7 +212,7 @@ int zgbequ_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBEQU", &i__1); + xerbla_("ZGBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbequb.c b/src/map/lapack2flamec/f2c/c/zgbequb.c index 154cf9ed9..97db99064 100644 --- a/src/map/lapack2flamec/f2c/c/zgbequb.c +++ b/src/map/lapack2flamec/f2c/c/zgbequb.c @@ -160,7 +160,7 @@ int zgbequb_(integer *m, integer *n, integer *kl, integer * ku, doublecomplex *a doublereal radix, rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -218,7 +218,7 @@ int zgbequb_(integer *m, integer *n, integer *kl, integer * ku, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBEQUB", &i__1); + xerbla_("ZGBEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbrfs.c b/src/map/lapack2flamec/f2c/c/zgbrfs.c index 8550fffb7..de9489b48 100644 --- a/src/map/lapack2flamec/f2c/c/zgbrfs.c +++ b/src/map/lapack2flamec/f2c/c/zgbrfs.c @@ -227,7 +227,7 @@ int zgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; doublereal lstres; @@ -320,7 +320,7 @@ int zgbrfs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBRFS", &i__1); + xerbla_("ZGBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbrfsx.c b/src/map/lapack2flamec/f2c/c/zgbrfsx.c index 54ecb51ea..8bcce48b9 100644 --- a/src/map/lapack2flamec/f2c/c/zgbrfsx.c +++ b/src/map/lapack2flamec/f2c/c/zgbrfsx.c @@ -461,7 +461,7 @@ int zgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in doublereal anorm; extern doublereal zla_gbrcond_c_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, logical *, integer *, doublecomplex *, doublereal *), zla_gbrcond_x_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlangb_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zgbcon_(char *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *); @@ -625,7 +625,7 @@ int zgbrfsx_(char *trans, char *equed, integer *n, integer * kl, integer *ku, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBRFSX", &i__1); + xerbla_("ZGBRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbsv.c b/src/map/lapack2flamec/f2c/c/zgbsv.c index 76f99d81e..2727ab5c3 100644 --- a/src/map/lapack2flamec/f2c/c/zgbsv.c +++ b/src/map/lapack2flamec/f2c/c/zgbsv.c @@ -160,7 +160,7 @@ int zgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, doublecomplex * integer ab_dim1, ab_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), zgbtrf_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgbtrf_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -213,7 +213,7 @@ int zgbsv_(integer *n, integer *kl, integer *ku, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBSV ", &i__1); + xerbla_("ZGBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbsvx.c b/src/map/lapack2flamec/f2c/c/zgbsvx.c index cb9a96bdd..b39726f2a 100644 --- a/src/map/lapack2flamec/f2c/c/zgbsvx.c +++ b/src/map/lapack2flamec/f2c/c/zgbsvx.c @@ -388,7 +388,7 @@ int zgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ logical nofact; extern doublereal zlangb_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlaqgb_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, char *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaqgb_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, char *); doublereal bignum; extern /* Subroutine */ int zgbcon_(char *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *); @@ -454,6 +454,8 @@ int zgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -585,7 +587,7 @@ int zgbsvx_(char *fact, char *trans, integer *n, integer *kl, integer *ku, integ if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBSVX", &i__1); + xerbla_("ZGBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbsvxx.c b/src/map/lapack2flamec/f2c/c/zgbsvxx.c index e8e4d7eba..451a38680 100644 --- a/src/map/lapack2flamec/f2c/c/zgbsvxx.c +++ b/src/map/lapack2flamec/f2c/c/zgbsvxx.c @@ -574,7 +574,7 @@ int zgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int doublereal colcnd; logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *), zlaqgb_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, char *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaqgb_( integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, char *); doublereal bignum; integer infequ; logical colequ; @@ -776,7 +776,7 @@ int zgbsvxx_(char *fact, char *trans, integer *n, integer * kl, integer *ku, int if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBSVXX", &i__1); + xerbla_("ZGBSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgbtf2.c b/src/map/lapack2flamec/f2c/c/zgbtf2.c index 55b60cff2..9e3acb993 100644 --- a/src/map/lapack2flamec/f2c/c/zgbtf2.c +++ b/src/map/lapack2flamec/f2c/c/zgbtf2.c @@ -154,7 +154,7 @@ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, /* Local variables */ integer i__, j, km, jp, ju, kv; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer izamax_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -214,7 +214,7 @@ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBTF2", &i__1); + xerbla_("ZGBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -225,7 +225,7 @@ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -262,8 +262,8 @@ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ if(j%32==0 || j==i__1){ - step_count=j; - AOCL_FLA_PROGRESS_FUNC_PTR("ZGBTF2",6,&step_count,&thread_id,&total_threads); + progress_step_count = j; + AOCL_FLA_PROGRESS_FUNC_PTR("ZGBTF2",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } } #endif diff --git a/src/map/lapack2flamec/f2c/c/zgbtrf.c b/src/map/lapack2flamec/f2c/c/zgbtrf.c index ef498b4a8..01f81c4aa 100644 --- a/src/map/lapack2flamec/f2c/c/zgbtrf.c +++ b/src/map/lapack2flamec/f2c/c/zgbtrf.c @@ -160,7 +160,7 @@ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, , work31[4160] /* was [65][64] */ ; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_( char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zgbtf2_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_( char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zgbtf2_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *), izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ int zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); @@ -224,7 +224,7 @@ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBTRF", &i__1); + xerbla_("ZGBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -235,7 +235,7 @@ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, return 0; } #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -324,11 +324,11 @@ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku, doublecomplex *ab, jb = fla_min(i__3,i__4); #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=jb; - AOCL_FLA_PROGRESS_FUNC_PTR("ZGBTRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=jb; + AOCL_FLA_PROGRESS_FUNC_PTR("ZGBTRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } - #endif + #endif /* The active part of the matrix is partitioned */ /* A11 A12 A13 */ diff --git a/src/map/lapack2flamec/f2c/c/zgbtrs.c b/src/map/lapack2flamec/f2c/c/zgbtrs.c index 46014e430..4dab37267 100644 --- a/src/map/lapack2flamec/f2c/c/zgbtrs.c +++ b/src/map/lapack2flamec/f2c/c/zgbtrs.c @@ -144,7 +144,7 @@ int zgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d extern logical lsame_(char *, char *); logical lnoti; extern /* Subroutine */ - int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -209,7 +209,7 @@ int zgbtrs_(char *trans, integer *n, integer *kl, integer * ku, integer *nrhs, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZGBTRS", &i__1); + xerbla_("ZGBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgebak.c b/src/map/lapack2flamec/f2c/c/zgebak.c index a1e9a42c7..4f77b6a45 100644 --- a/src/map/lapack2flamec/f2c/c/zgebak.c +++ b/src/map/lapack2flamec/f2c/c/zgebak.c @@ -134,7 +134,7 @@ int zgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl extern logical lsame_(char *, char *); logical leftv; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); logical rightv; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -197,7 +197,7 @@ int zgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEBAK", &i__1); + xerbla_("ZGEBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgebal.c b/src/map/lapack2flamec/f2c/c/zgebal.c index b69ce096d..3e2dc51c0 100644 --- a/src/map/lapack2flamec/f2c/c/zgebal.c +++ b/src/map/lapack2flamec/f2c/c/zgebal.c @@ -175,7 +175,7 @@ int zgebal_(char *job, integer *n, doublecomplex *a, integer *lda, integer *ilo, extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_( char *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *); logical noconv; /* -- LAPACK computational routine (version 3.7.1) -- */ @@ -219,7 +219,7 @@ int zgebal_(char *job, integer *n, doublecomplex *a, integer *lda, integer *ilo, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEBAL", &i__1); + xerbla_("ZGEBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -390,7 +390,7 @@ int zgebal_(char *job, integer *n, doublecomplex *a, integer *lda, integer *ilo, /* Exit if NaN to avoid infinite loop */ *info = -3; i__2 = -(*info); - xerbla_("ZGEBAL", &i__2); + xerbla_("ZGEBAL", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgebd2.c b/src/map/lapack2flamec/f2c/c/zgebd2.c index 3d2db2d91..e452bfbfc 100644 --- a/src/map/lapack2flamec/f2c/c/zgebd2.c +++ b/src/map/lapack2flamec/f2c/c/zgebd2.c @@ -202,7 +202,7 @@ int zgebd2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * integer i__; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -248,7 +248,7 @@ int zgebd2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info < 0) { i__1 = -(*info); - xerbla_("ZGEBD2", &i__1); + xerbla_("ZGEBD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgebrd.c b/src/map/lapack2flamec/f2c/c/zgebrd.c index 103927045..e19e00094 100644 --- a/src/map/lapack2flamec/f2c/c/zgebrd.c +++ b/src/map/lapack2flamec/f2c/c/zgebrd.c @@ -224,7 +224,7 @@ int zgebrd_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * /* Local variables */ integer i__, j, nb, nx, ws, nbmin, iinfo, minmn; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgebd2_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *), zlabrd_(integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgebd2_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlabrd_(integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwrkx, ldwrky, lwkopt; logical lquery; @@ -293,7 +293,7 @@ int zgebrd_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info < 0) { i__1 = -(*info); - xerbla_("ZGEBRD", &i__1); + xerbla_("ZGEBRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgecon.c b/src/map/lapack2flamec/f2c/c/zgecon.c index c481f7c19..78517d332 100644 --- a/src/map/lapack2flamec/f2c/c/zgecon.c +++ b/src/map/lapack2flamec/f2c/c/zgecon.c @@ -134,7 +134,7 @@ int zgecon_(char *norm, integer *n, doublecomplex *a, integer *lda, doublereal * int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); logical onenrm; @@ -199,7 +199,7 @@ int zgecon_(char *norm, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGECON", &i__1); + xerbla_("ZGECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeequ.c b/src/map/lapack2flamec/f2c/c/zgeequ.c index 7edae2288..e25a15427 100644 --- a/src/map/lapack2flamec/f2c/c/zgeequ.c +++ b/src/map/lapack2flamec/f2c/c/zgeequ.c @@ -140,7 +140,7 @@ int zgeequ_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * doublereal rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -190,7 +190,7 @@ int zgeequ_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEEQU", &i__1); + xerbla_("ZGEEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeequb.c b/src/map/lapack2flamec/f2c/c/zgeequb.c index e1e930045..82f4f8842 100644 --- a/src/map/lapack2flamec/f2c/c/zgeequb.c +++ b/src/map/lapack2flamec/f2c/c/zgeequb.c @@ -146,7 +146,7 @@ int zgeequb_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal doublereal radix, rcmin, rcmax; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, logrdx, smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -196,7 +196,7 @@ int zgeequb_(integer *m, integer *n, doublecomplex *a, integer *lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEEQUB", &i__1); + xerbla_("ZGEEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgees.c b/src/map/lapack2flamec/f2c/c/zgees.c index 9e4b221bb..3d032c3a7 100644 --- a/src/map/lapack2flamec/f2c/c/zgees.c +++ b/src/map/lapack2flamec/f2c/c/zgees.c @@ -192,7 +192,7 @@ elements 1:ILO-1 and i+1:N of W */ /* > \ingroup complex16GEeigen */ /* ===================================================================== */ /* Subroutine */ -int zgees_(char *jobvs, char *sort, L_fp select, integer *n, doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) +int zgees_(char *jobvs, char *sort, L_fpz1 select, integer *n, doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgees inputs: jobvs %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", sdim %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *n, *lda, *sdim, *ldvs); @@ -215,7 +215,7 @@ int zgees_(char *jobvs, char *sort, L_fp select, integer *n, doublecomplex *a, i extern doublereal dlamch_(char *); doublereal cscale; extern /* Subroutine */ - int zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -338,7 +338,7 @@ int zgees_(char *jobvs, char *sort, L_fp select, integer *n, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEES ", &i__1); + xerbla_("ZGEES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeesx.c b/src/map/lapack2flamec/f2c/c/zgeesx.c index ea45a1917..b8d57f4cc 100644 --- a/src/map/lapack2flamec/f2c/c/zgeesx.c +++ b/src/map/lapack2flamec/f2c/c/zgeesx.c @@ -238,7 +238,7 @@ if */ /* > \ingroup complex16GEeigen */ /* ===================================================================== */ /* Subroutine */ -int zgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, doublecomplex *vs, integer *ldvs, doublereal * rconde, doublereal *rcondv, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) +int zgeesx_(char *jobvs, char *sort, L_fpz1 select, char * sense, integer *n, doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, doublecomplex *vs, integer *ldvs, doublereal * rconde, doublereal *rcondv, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgeesx inputs: jobvs %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", sdim %" FLA_IS ", ldvs %" FLA_IS "",*jobvs, *sort, *sense, *n, *lda, *sdim, *ldvs); @@ -259,7 +259,7 @@ int zgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub extern doublereal dlamch_(char *); doublereal cscale; extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -361,6 +361,7 @@ int zgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub /* If SENSE = 'E', 'V' or 'B', then the amount of workspace needed */ /* depends on SDIM, which is computed by the routine ZTRSEN later */ /* in the code.) */ + maxwrk = 0; if (*info == 0) { if (*n == 0) @@ -405,7 +406,7 @@ int zgeesx_(char *jobvs, char *sort, L_fp select, char * sense, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEESX", &i__1); + xerbla_("ZGEESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeev.c b/src/map/lapack2flamec/f2c/c/zgeev.c index f8b6c0a28..ee3a88d52 100644 --- a/src/map/lapack2flamec/f2c/c/zgeev.c +++ b/src/map/lapack2flamec/f2c/c/zgeev.c @@ -205,7 +205,7 @@ int zgeev_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, int zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; extern /* Subroutine */ @@ -356,7 +356,7 @@ int zgeev_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEEV ", &i__1); + xerbla_("ZGEEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeevx.c b/src/map/lapack2flamec/f2c/c/zgeevx.c index f816bb35b..4f2e3201c 100644 --- a/src/map/lapack2flamec/f2c/c/zgeevx.c +++ b/src/map/lapack2flamec/f2c/c/zgeevx.c @@ -317,7 +317,7 @@ int zgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublecomplex *, integer *, integer *), zgebal_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; extern /* Subroutine */ @@ -523,7 +523,7 @@ int zgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEEVX", &i__1); + xerbla_("ZGEEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgegs.c b/src/map/lapack2flamec/f2c/c/zgegs.c index 273cc8f3d..eaf3904c6 100644 --- a/src/map/lapack2flamec/f2c/c/zgegs.c +++ b/src/map/lapack2flamec/f2c/c/zgegs.c @@ -248,7 +248,7 @@ int zgegs_(char *jobvsl, char *jobvsr, integer *n, doublecomplex *a, integer *ld logical ilascl, ilbscl; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -393,7 +393,7 @@ int zgegs_(char *jobvsl, char *jobvsr, integer *n, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEGS ", &i__1); + xerbla_("ZGEGS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgegv.c b/src/map/lapack2flamec/f2c/c/zgegv.c index f217a7091..4c4ad019d 100644 --- a/src/map/lapack2flamec/f2c/c/zgegv.c +++ b/src/map/lapack2flamec/f2c/c/zgegv.c @@ -313,7 +313,7 @@ int zgegv_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal salfar, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; char chtemp[1]; logical ldumma[1]; @@ -468,7 +468,7 @@ int zgegv_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEGV ", &i__1); + xerbla_("ZGEGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgehd2.c b/src/map/lapack2flamec/f2c/c/zgehd2.c index 99f915bec..f4a5988e5 100644 --- a/src/map/lapack2flamec/f2c/c/zgehd2.c +++ b/src/map/lapack2flamec/f2c/c/zgehd2.c @@ -152,7 +152,7 @@ int zgehd2_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l integer i__; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -199,7 +199,7 @@ int zgehd2_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEHD2", &i__1); + xerbla_("ZGEHD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgehrd.c b/src/map/lapack2flamec/f2c/c/zgehrd.c index b867a8177..a476b403e 100644 --- a/src/map/lapack2flamec/f2c/c/zgehrd.c +++ b/src/map/lapack2flamec/f2c/c/zgehrd.c @@ -180,7 +180,7 @@ int zgehrd_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l doublecomplex ei; integer nb, nh, nx, iwt, nbmin, iinfo; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zgehd2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zlahr2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zgehd2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zlahr2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -216,6 +216,7 @@ int zgehrd_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l /* Function Body */ *info = 0; lquery = *lwork == -1; + nx = 0; if (*n < 0) { *info = -1; @@ -250,7 +251,7 @@ int zgehrd_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEHRD", &i__1); + xerbla_("ZGEHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgejsv.c b/src/map/lapack2flamec/f2c/c/zgejsv.c index 30454a766..9b89b6c60 100644 --- a/src/map/lapack2flamec/f2c/c/zgejsv.c +++ b/src/map/lapack2flamec/f2c/c/zgejsv.c @@ -641,7 +641,7 @@ int zgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo logical goscal; doublereal aatmin, aatmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical noscal; extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *), dlassq_(integer *, doublereal *, integer *, doublereal *, doublereal *); @@ -724,6 +724,10 @@ int zgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo defr = lsame_(jobr, "N"); l2pert = lsame_(jobp, "P"); lquery = *lwork == -1 || *lrwork == -1; + iwoff = 0; + lwrk_zgeqrf__ = 0; + lwrk_zgelqf__ = 0; + lwrk_zgeqp3__ = 0; if (! (rowpiv || l2rank || l2aber || errest || lsame_(joba, "C"))) { *info = -1; @@ -1302,7 +1306,7 @@ int zgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { /* #:( */ i__1 = -(*info); - xerbla_("ZGEJSV", &i__1); + xerbla_("ZGEJSV", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -1373,7 +1377,7 @@ int zgejsv_(char *joba, char *jobu, char *jobv, char *jobr, char *jobt, char *jo { *info = -9; i__2 = -(*info); - xerbla_("ZGEJSV", &i__2); + xerbla_("ZGEJSV", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelq.c b/src/map/lapack2flamec/f2c/c/zgelq.c index f35e6f156..015fdb562 100644 --- a/src/map/lapack2flamec/f2c/c/zgelq.c +++ b/src/map/lapack2flamec/f2c/c/zgelq.c @@ -178,7 +178,7 @@ int zgelq_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex logical mint, minw; integer lwmin, lwreq, lwopt, nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgelqt_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -373,7 +373,7 @@ int zgelq_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQ", &i__1); + xerbla_("ZGELQ", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelq2.c b/src/map/lapack2flamec/f2c/c/zgelq2.c index ebd356274..ea1f62d3f 100644 --- a/src/map/lapack2flamec/f2c/c/zgelq2.c +++ b/src/map/lapack2flamec/f2c/c/zgelq2.c @@ -120,7 +120,7 @@ int zgelq2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple integer i__, k; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int zgelq2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQ2", &i__1); + xerbla_("ZGELQ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelqf.c b/src/map/lapack2flamec/f2c/c/zgelqf.c index 0c72f3380..a2be2b95c 100644 --- a/src/map/lapack2flamec/f2c/c/zgelqf.c +++ b/src/map/lapack2flamec/f2c/c/zgelqf.c @@ -139,7 +139,7 @@ int zgelqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zgelq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zgelq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -199,7 +199,7 @@ int zgelqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQF", &i__1); + xerbla_("ZGELQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelqt.c b/src/map/lapack2flamec/f2c/c/zgelqt.c index 3df8e6f6e..e3962d97b 100644 --- a/src/map/lapack2flamec/f2c/c/zgelqt.c +++ b/src/map/lapack2flamec/f2c/c/zgelqt.c @@ -136,7 +136,7 @@ int zgelqt_(integer *m, integer *n, integer *mb, doublecomplex *a, integer *lda, /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgelqt3_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *) ; + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgelqt3_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *) ; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -186,7 +186,7 @@ int zgelqt_(integer *m, integer *n, integer *mb, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQT", &i__1); + xerbla_("ZGELQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelqt3.c b/src/map/lapack2flamec/f2c/c/zgelqt3.c index e01d9c244..70048f545 100644 --- a/src/map/lapack2flamec/f2c/c/zgelqt3.c +++ b/src/map/lapack2flamec/f2c/c/zgelqt3.c @@ -138,7 +138,7 @@ int zgelqt3_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl /* Local variables */ integer i__, j, i1, j1, m1, m2, iinfo; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -183,7 +183,7 @@ int zgelqt3_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELQT3", &i__1); + xerbla_("ZGELQT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgels.c b/src/map/lapack2flamec/f2c/c/zgels.c index 6a7e33a41..a939f93bf 100644 --- a/src/map/lapack2flamec/f2c/c/zgels.c +++ b/src/map/lapack2flamec/f2c/c/zgels.c @@ -208,7 +208,7 @@ int zgels_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; doublereal bignum; @@ -348,7 +348,7 @@ int zgels_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELS ", &i__1); + xerbla_("ZGELS ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelsd.c b/src/map/lapack2flamec/f2c/c/zgelsd.c index c91ee473c..fab7203f6 100644 --- a/src/map/lapack2flamec/f2c/c/zgelsd.c +++ b/src/map/lapack2flamec/f2c/c/zgelsd.c @@ -243,7 +243,7 @@ int zgelsd_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -298,6 +298,7 @@ int zgelsd_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld minmn = fla_min(*m,*n); maxmn = fla_max(*m,*n); lquery = *lwork == -1; + mnthr = 0; if (*m < 0) { *info = -1; @@ -473,7 +474,7 @@ int zgelsd_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSD", &i__1); + xerbla_("ZGELSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelss.c b/src/map/lapack2flamec/f2c/c/zgelss.c index 6d11f2076..a57a6964c 100644 --- a/src/map/lapack2flamec/f2c/c/zgelss.c +++ b/src/map/lapack2flamec/f2c/c/zgelss.c @@ -194,7 +194,7 @@ int zgelss_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld integer i__, bl, ie, il, mm; doublecomplex dum[1]; doublereal eps, thr, anrm, bnrm; - integer itau, lwork_zgebrd__, lwork_zgelqf__, lwork_zgeqrf__, lwork_zungbr__, lwork_zunmbr__, iascl, ibscl, lwork_zunmlq__, chunk, lwork_zunmqr__; + integer itau, lwork_zgebrd__, lwork_zgelqf__, lwork_zungbr__, lwork_zunmbr__, iascl, ibscl, lwork_zunmlq__, chunk; doublereal sfmin; integer minmn; extern /* Subroutine */ @@ -207,7 +207,7 @@ int zgelss_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -291,6 +291,7 @@ int zgelss_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld /* CWorkspace refers to complex workspace, and RWorkspace refers */ /* to real workspace. NB refers to the optimal block size for the */ /* immediately following subroutine, as returned by ILAENV.) */ + mnthr = ilaenv_(&c__6, "ZGELSS", " ", m, n, nrhs, &c_n1); if (*info == 0) { minwrk = 1; @@ -298,17 +299,14 @@ int zgelss_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (minmn > 0) { mm = *m; - mnthr = ilaenv_(&c__6, "ZGELSS", " ", m, n, nrhs, &c_n1); if (*m >= *n && *m >= mnthr) { /* Path 1a - overdetermined, with many more rows than */ /* columns */ /* Compute space needed for ZGEQRF */ zgeqrf_(m, n, &a[a_offset], lda, dum, dum, &c_n1, info); - lwork_zgeqrf__ = (integer) dum[0].r; /* Compute space needed for ZUNMQR */ zunmqr_("L", "C", m, nrhs, n, &a[a_offset], lda, dum, &b[ b_offset], ldb, dum, &c_n1, info); - lwork_zunmqr__ = (integer) dum[0].r; mm = *n; /* Computing MAX */ i__1 = maxwrk; @@ -444,7 +442,7 @@ int zgelss_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSS", &i__1); + xerbla_("ZGELSS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelst.c b/src/map/lapack2flamec/f2c/c/zgelst.c index b06292942..677b266e7 100644 --- a/src/map/lapack2flamec/f2c/c/zgelst.c +++ b/src/map/lapack2flamec/f2c/c/zgelst.c @@ -219,7 +219,7 @@ int zgelst_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex * int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer scllen; doublereal bignum; @@ -329,7 +329,7 @@ int zgelst_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELST ", &i__1); + xerbla_("ZGELST ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelsx.c b/src/map/lapack2flamec/f2c/c/zgelsx.c index 1a1dbf951..97dcf8a7f 100644 --- a/src/map/lapack2flamec/f2c/c/zgelsx.c +++ b/src/map/lapack2flamec/f2c/c/zgelsx.c @@ -205,7 +205,7 @@ int zgelsx_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zlaic1_(integer *, integer *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; extern /* Subroutine */ @@ -277,7 +277,7 @@ int zgelsx_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSX", &i__1); + xerbla_("ZGELSX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgelsy.c b/src/map/lapack2flamec/f2c/c/zgelsy.c index d29487188..4fdbb806d 100644 --- a/src/map/lapack2flamec/f2c/c/zgelsy.c +++ b/src/map/lapack2flamec/f2c/c/zgelsy.c @@ -234,7 +234,7 @@ int zgelsy_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zlaic1_(integer *, integer *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), dlabad_(doublereal *, doublereal *), zgeqp3_( integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublereal *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -338,7 +338,7 @@ int zgelsy_(integer *m, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZGELSY", &i__1); + xerbla_("ZGELSY", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgemlq.c b/src/map/lapack2flamec/f2c/c/zgemlq.c index ddd0291fc..d451807f0 100644 --- a/src/map/lapack2flamec/f2c/c/zgemlq.c +++ b/src/map/lapack2flamec/f2c/c/zgemlq.c @@ -175,9 +175,8 @@ int zgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int zgemlqt_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -228,21 +227,6 @@ int zgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec lw = *m * mb; mn = *n; } - if (nb > *k && mn > *k) - { - if ((mn - *k) % (nb - *k) == 0) - { - nblcks = (mn - *k) / (nb - *k); - } - else - { - nblcks = (mn - *k) / (nb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -288,7 +272,7 @@ int zgemlq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEMLQ", &i__1); + xerbla_("ZGEMLQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgemlqt.c b/src/map/lapack2flamec/f2c/c/zgemlqt.c index 43dbaedef..085bcaa99 100644 --- a/src/map/lapack2flamec/f2c/c/zgemlqt.c +++ b/src/map/lapack2flamec/f2c/c/zgemlqt.c @@ -167,7 +167,7 @@ int zgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical notran; integer ldwork; /* -- LAPACK computational routine -- */ @@ -255,7 +255,7 @@ int zgemlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEMLQT", &i__1); + xerbla_("ZGEMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgemqr.c b/src/map/lapack2flamec/f2c/c/zgemqr.c index 75c8f5b4e..1dd464d0a 100644 --- a/src/map/lapack2flamec/f2c/c/zgemqr.c +++ b/src/map/lapack2flamec/f2c/c/zgemqr.c @@ -178,9 +178,8 @@ int zgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec logical left, tran; extern logical lsame_(char *, char *); logical right; - integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int zgemqrt_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -231,21 +230,6 @@ int zgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec lw = mb * nb; mn = *n; } - if (mb > *k && mn > *k) - { - if ((mn - *k) % (mb - *k) == 0) - { - nblcks = (mn - *k) / (mb - *k); - } - else - { - nblcks = (mn - *k) / (mb - *k) + 1; - } - } - else - { - nblcks = 1; - } *info = 0; if (! left && ! right) { @@ -291,7 +275,7 @@ int zgemqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEMQR", &i__1); + xerbla_("ZGEMQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgemqrt.c b/src/map/lapack2flamec/f2c/c/zgemqrt.c index 3d760f31d..4525cd003 100644 --- a/src/map/lapack2flamec/f2c/c/zgemqrt.c +++ b/src/map/lapack2flamec/f2c/c/zgemqrt.c @@ -170,7 +170,7 @@ int zgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical notran; integer ldwork; /* -- LAPACK computational routine (version 3.7.0) -- */ @@ -259,7 +259,7 @@ int zgemqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEMQRT", &i__1); + xerbla_("ZGEMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeql2.c b/src/map/lapack2flamec/f2c/c/zgeql2.c index c91f8a89b..fb7666831 100644 --- a/src/map/lapack2flamec/f2c/c/zgeql2.c +++ b/src/map/lapack2flamec/f2c/c/zgeql2.c @@ -128,7 +128,7 @@ int zgeql2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple integer i__, k; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -171,7 +171,7 @@ int zgeql2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQL2", &i__1); + xerbla_("ZGEQL2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqlf.c b/src/map/lapack2flamec/f2c/c/zgeqlf.c index 858bd9d36..f1b4a16da 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqlf.c +++ b/src/map/lapack2flamec/f2c/c/zgeqlf.c @@ -142,7 +142,7 @@ int zgeqlf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zgeql2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zgeql2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -191,6 +191,7 @@ int zgeqlf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple { *info = -4; } + nb = ilaenv_(&c__1, "ZGEQLF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { k = fla_min(*m,*n); @@ -200,7 +201,6 @@ int zgeqlf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple } else { - nb = ilaenv_(&c__1, "ZGEQLF", " ", m, n, &c_n1, &c_n1); lwkopt = *n * nb; } work[1].r = (doublereal) lwkopt; @@ -213,7 +213,7 @@ int zgeqlf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQLF", &i__1); + xerbla_("ZGEQLF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqp3.c b/src/map/lapack2flamec/f2c/c/zgeqp3.c index 7426dae15..93b65fae7 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqp3.c +++ b/src/map/lapack2flamec/f2c/c/zgeqp3.c @@ -168,7 +168,7 @@ int zgeqp3_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *jpv int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaqp2_(integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublereal *, doublereal *, doublecomplex *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgeqrf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer * ); @@ -254,7 +254,7 @@ int zgeqp3_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQP3", &i__1); + xerbla_("ZGEQP3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqpf.c b/src/map/lapack2flamec/f2c/c/zgeqpf.c index d0fe269d4..884e9d5d0 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqpf.c +++ b/src/map/lapack2flamec/f2c/c/zgeqpf.c @@ -164,7 +164,7 @@ int zgeqpf_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *jpv int zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlarfg_( integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_( integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -211,7 +211,7 @@ int zgeqpf_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *jpv if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQPF", &i__1); + xerbla_("ZGEQPF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqr.c b/src/map/lapack2flamec/f2c/c/zgeqr.c index dd022166b..b2a5c5795 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqr.c +++ b/src/map/lapack2flamec/f2c/c/zgeqr.c @@ -180,7 +180,7 @@ int zgeqr_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex logical mint, minw; integer nblcks; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical lminws; extern /* Subroutine */ @@ -358,7 +358,7 @@ int zgeqr_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQR", &i__1); + xerbla_("ZGEQR", &i__1, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqr2.c b/src/map/lapack2flamec/f2c/c/zgeqr2.c index 2999efbfc..00eccb929 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqr2.c +++ b/src/map/lapack2flamec/f2c/c/zgeqr2.c @@ -124,7 +124,7 @@ int zgeqr2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple integer i__, k; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int zgeqr2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQR2", &i__1); + xerbla_("ZGEQR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqr2p.c b/src/map/lapack2flamec/f2c/c/zgeqr2p.c index 07e5388f4..0bc2055ac 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqr2p.c +++ b/src/map/lapack2flamec/f2c/c/zgeqr2p.c @@ -124,7 +124,7 @@ int zgeqr2p_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl integer i__, k; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfgp_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfgp_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int zgeqr2p_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQR2P", &i__1); + xerbla_("ZGEQR2P", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqrf.c b/src/map/lapack2flamec/f2c/c/zgeqrf.c index 523cedef8..03d7ed7df 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqrf.c +++ b/src/map/lapack2flamec/f2c/c/zgeqrf.c @@ -150,7 +150,7 @@ int zgeqrf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -210,7 +210,7 @@ int zgeqrf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRF", &i__1); + xerbla_("ZGEQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqrfp.c b/src/map/lapack2flamec/f2c/c/zgeqrfp.c index 4b0af9b0c..5b4982e91 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqrfp.c +++ b/src/map/lapack2flamec/f2c/c/zgeqrfp.c @@ -139,7 +139,7 @@ int zgeqrfp_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl /* Local variables */ integer i__, k, ib, nb, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -201,7 +201,7 @@ int zgeqrfp_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRFP", &i__1); + xerbla_("ZGEQRFP", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqrt.c b/src/map/lapack2flamec/f2c/c/zgeqrt.c index 9d6a63050..f64941dae 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqrt.c +++ b/src/map/lapack2flamec/f2c/c/zgeqrt.c @@ -137,7 +137,7 @@ int zgeqrt_(integer *m, integer *n, integer *nb, doublecomplex *a, integer *lda, /* Local variables */ integer i__, k, ib, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgeqrt2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zgeqrt3_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfb_( char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgeqrt2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zgeqrt3_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -187,7 +187,7 @@ int zgeqrt_(integer *m, integer *n, integer *nb, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRT", &i__1); + xerbla_("ZGEQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqrt2.c b/src/map/lapack2flamec/f2c/c/zgeqrt2.c index b8db0a90a..d833274fd 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqrt2.c +++ b/src/map/lapack2flamec/f2c/c/zgeqrt2.c @@ -139,7 +139,7 @@ int zgeqrt2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl integer i__, k; doublecomplex aii, alpha; extern /* Subroutine */ - int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -184,7 +184,7 @@ int zgeqrt2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRT2", &i__1); + xerbla_("ZGEQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgeqrt3.c b/src/map/lapack2flamec/f2c/c/zgeqrt3.c index 6ab49f219..a29c055fc 100644 --- a/src/map/lapack2flamec/f2c/c/zgeqrt3.c +++ b/src/map/lapack2flamec/f2c/c/zgeqrt3.c @@ -139,7 +139,7 @@ int zgeqrt3_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl /* Local variables */ integer i__, j, i1, j1, n1, n2, iinfo; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -184,7 +184,7 @@ int zgeqrt3_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGEQRT3", &i__1); + xerbla_("ZGEQRT3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgerfs.c b/src/map/lapack2flamec/f2c/c/zgerfs.c index 8854b1f87..53e53e1e4 100644 --- a/src/map/lapack2flamec/f2c/c/zgerfs.c +++ b/src/map/lapack2flamec/f2c/c/zgerfs.c @@ -203,7 +203,7 @@ int zgerfs_(char *trans, integer *n, integer *nrhs, doublecomplex *a, integer *l extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; doublereal lstres; @@ -288,7 +288,7 @@ int zgerfs_(char *trans, integer *n, integer *nrhs, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGERFS", &i__1); + xerbla_("ZGERFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgerfsx.c b/src/map/lapack2flamec/f2c/c/zgerfsx.c index 9d9707767..4ee3ce199 100644 --- a/src/map/lapack2flamec/f2c/c/zgerfsx.c +++ b/src/map/lapack2flamec/f2c/c/zgerfsx.c @@ -434,7 +434,7 @@ int zgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, doublecomplex doublereal anorm; extern doublereal zla_gercond_c_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, logical *, integer *, doublecomplex *, doublereal *), zla_gercond_x_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zgecon_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *); @@ -590,7 +590,7 @@ int zgerfsx_(char *trans, char *equed, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGERFSX", &i__1); + xerbla_("ZGERFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgerq2.c b/src/map/lapack2flamec/f2c/c/zgerq2.c index 96f4f3f70..5b454f203 100644 --- a/src/map/lapack2flamec/f2c/c/zgerq2.c +++ b/src/map/lapack2flamec/f2c/c/zgerq2.c @@ -123,7 +123,7 @@ int zgerq2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple integer i__, k; doublecomplex alpha; extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -166,7 +166,7 @@ int zgerq2_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGERQ2", &i__1); + xerbla_("ZGERQ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgerqf.c b/src/map/lapack2flamec/f2c/c/zgerqf.c index 550303333..2af8d2fd9 100644 --- a/src/map/lapack2flamec/f2c/c/zgerqf.c +++ b/src/map/lapack2flamec/f2c/c/zgerqf.c @@ -143,7 +143,7 @@ int zgerqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Local variables */ integer i__, k, ib, nb, ki, kk, mu, nu, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zgerq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zgerq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -191,6 +191,7 @@ int zgerqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple { *info = -4; } + nb = ilaenv_(&c__1, "ZGERQF", " ", m, n, &c_n1, &c_n1); if (*info == 0) { k = fla_min(*m,*n); @@ -200,7 +201,6 @@ int zgerqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple } else { - nb = ilaenv_(&c__1, "ZGERQF", " ", m, n, &c_n1, &c_n1); lwkopt = *m * nb; } work[1].r = (doublereal) lwkopt; @@ -216,7 +216,7 @@ int zgerqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZGERQF", &i__1); + xerbla_("ZGERQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesdd.c b/src/map/lapack2flamec/f2c/c/zgesdd.c index 5fc85c3df..d5a9dd6d9 100644 --- a/src/map/lapack2flamec/f2c/c/zgesdd.c +++ b/src/map/lapack2flamec/f2c/c/zgesdd.c @@ -279,7 +279,7 @@ int zgesdd_(char *jobz, integer *m, integer *n, doublecomplex *a, integer *lda, int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zgebrd_( integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgebrd_( integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); doublereal bignum; extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ @@ -815,7 +815,7 @@ int zgesdd_(char *jobz, integer *m, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESDD", &i__1); + xerbla_("ZGESDD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesv.c b/src/map/lapack2flamec/f2c/c/zgesv.c index e5e6cbc57..f3d8efbb8 100644 --- a/src/map/lapack2flamec/f2c/c/zgesv.c +++ b/src/map/lapack2flamec/f2c/c/zgesv.c @@ -119,7 +119,7 @@ int zgesv_(integer *n, integer *nrhs, doublecomplex *a, integer *lda, integer *i integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), zgetrf_( integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgetrf_( integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -164,7 +164,7 @@ int zgesv_(integer *n, integer *nrhs, doublecomplex *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESV ", &i__1); + xerbla_("ZGESV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvd.c b/src/map/lapack2flamec/f2c/c/zgesvd.c index 1c5b9660e..362b326bd 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvd.c +++ b/src/map/lapack2flamec/f2c/c/zgesvd.c @@ -13,7 +13,6 @@ static doublecomplex c_b2 = ; static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c_n1 = -1; static integer c__1 = 1; /* > \brief ZGESVD computes the singular value decomposition (SVD) for GE matrices */ @@ -237,8 +236,7 @@ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n, doublecomplex *a, i AOCL_DTL_SNPRINTF("zgesvd inputs: jobu %c, jobvt %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS "",*jobu, *jobvt, *m, *n, *lda, *ldu, *ldvt); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -260,7 +258,7 @@ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n, doublecomplex *a, i logical wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs; extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -330,6 +328,8 @@ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n, doublecomplex *a, i wntvo = lsame_(jobvt, "O"); wntvn = lsame_(jobvt, "N"); lquery = *lwork == -1; + mnthr = 0; + wrkbl = 0; if (! (wntua || wntus || wntuo || wntun)) { *info = -1; @@ -892,7 +892,7 @@ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n, doublecomplex *a, i if (*info != 0) { i__2 = -(*info); - xerbla_("ZGESVD", &i__2); + xerbla_("ZGESVD", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvdq.c b/src/map/lapack2flamec/f2c/c/zgesvdq.c index 2e13ad174..dd4663e7e 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvdq.c +++ b/src/map/lapack2flamec/f2c/c/zgesvdq.c @@ -468,7 +468,7 @@ int zgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer extern integer idamax_(integer *, doublereal *, integer *); doublereal sconda; extern /* Subroutine */ - int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zgelqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer * ), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -541,6 +541,10 @@ int zgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer acclh = lsame_(joba, "H") || conda; rowprm = lsame_(jobp, "P"); rtrans = lsame_(jobr, "T"); + sconda = 0.; + lwunq = 0; + lwrk_zunmqr__ = 0; + lwrk_zgeqp3__ = 0; if (rowprm) { /* Computing MAX */ @@ -935,7 +939,7 @@ int zgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESVDQ", &i__1); + xerbla_("ZGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -978,7 +982,7 @@ int zgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__2 = -(*info); - xerbla_("ZGESVDQ", &i__2); + xerbla_("ZGESVDQ", &i__2, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -1071,7 +1075,7 @@ int zgesvdq_(char *joba, char *jobp, char *jobr, char *jobu, char *jobv, integer { *info = -8; i__1 = -(*info); - xerbla_("ZGESVDQ", &i__1); + xerbla_("ZGESVDQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvdx.c b/src/map/lapack2flamec/f2c/c/zgesvdx.c index 44dcdc6a5..73b49dcc8 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvdx.c +++ b/src/map/lapack2flamec/f2c/c/zgesvdx.c @@ -8,7 +8,6 @@ static doublecomplex c_b1 = ; static integer c__6 = 6; static integer c__0 = 0; -static integer c__2 = 2; static integer c__1 = 1; static integer c_n1 = -1; /* > \brief ZGESVDX computes the singular value decomposition (SVD) for GE matrices */ @@ -281,8 +280,7 @@ int zgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgesvdx inputs: jobu %c, jobvt %c, range %c, m %" FLA_IS ", n %" FLA_IS ", lda %" FLA_IS ", il %" FLA_IS ", iu %" FLA_IS ", ns %" FLA_IS ", ldu %" FLA_IS ", ldvt %" FLA_IS "",*jobu, *jobvt, *range, *m, *n, *lda, *il, *iu, *ns, *ldu, *ldvt); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4, i__5; + integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__2, i__3, i__4, i__5; doublereal d__1; doublecomplex z__1; char ch__1[2]; @@ -305,10 +303,10 @@ int zgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub logical wantu; extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zgebrd_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); - doublereal bignum, abstol; + doublereal bignum; extern /* Subroutine */ int zgelqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer * ), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *); char rngtgk[1]; @@ -364,11 +362,11 @@ int zgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub /* Function Body */ *ns = 0; *info = 0; - abstol = dlamch_("S") * 2; lquery = *lwork == -1; minmn = fla_min(*m,*n); wantu = lsame_(jobu, "V"); wantvt = lsame_(jobvt, "V"); + mnthr = 0; if (wantu || wantvt) { *(unsigned char *)jobz = 'V'; @@ -546,7 +544,7 @@ int zgesvdx_(char *jobu, char *jobvt, char *range, integer * m, integer *n, doub if (*info != 0) { i__2 = -(*info); - xerbla_("ZGESVDX", &i__2); + xerbla_("ZGESVDX", &i__2, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvj.c b/src/map/lapack2flamec/f2c/c/zgesvj.c index 6fd2312d3..55968c46c 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvj.c +++ b/src/map/lapack2flamec/f2c/c/zgesvj.c @@ -411,7 +411,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband; extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *); @@ -530,7 +530,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESVJ", &i__1); + xerbla_("ZGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -590,7 +590,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco { *info = -4; i__1 = -(*info); - xerbla_("ZGESVJ", &i__1); + xerbla_("ZGESVJ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -632,7 +632,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco { *info = -6; i__2 = -(*info); - xerbla_("ZGESVJ", &i__2); + xerbla_("ZGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -676,7 +676,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco { *info = -6; i__2 = -(*info); - xerbla_("ZGESVJ", &i__2); + xerbla_("ZGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -720,7 +720,7 @@ int zgesvj_(char *joba, char *jobu, char *jobv, integer *m, integer *n, doubleco { *info = -6; i__2 = -(*info); - xerbla_("ZGESVJ", &i__2); + xerbla_("ZGESVJ", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvx.c b/src/map/lapack2flamec/f2c/c/zgesvx.c index a1767cf8b..d0dbb8a86 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvx.c +++ b/src/map/lapack2flamec/f2c/c/zgesvx.c @@ -361,7 +361,7 @@ int zgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex * doublereal colcnd; logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; extern /* Subroutine */ @@ -425,6 +425,8 @@ int zgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex * nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); notran = lsame_(trans, "N"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -548,7 +550,7 @@ int zgesvx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESVX", &i__1); + xerbla_("ZGESVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgesvxx.c b/src/map/lapack2flamec/f2c/c/zgesvxx.c index 815e76906..123f45735 100644 --- a/src/map/lapack2flamec/f2c/c/zgesvxx.c +++ b/src/map/lapack2flamec/f2c/c/zgesvxx.c @@ -554,7 +554,7 @@ int zgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex doublereal colcnd; logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int zlaqge_(integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, char *); @@ -748,7 +748,7 @@ int zgesvxx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGESVXX", &i__1); + xerbla_("ZGESVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgetc2.c b/src/map/lapack2flamec/f2c/c/zgetc2.c index 29ad258a6..996d14f15 100644 --- a/src/map/lapack2flamec/f2c/c/zgetc2.c +++ b/src/map/lapack2flamec/f2c/c/zgetc2.c @@ -154,6 +154,9 @@ int zgetc2_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, integer * --jpiv; /* Function Body */ *info = 0; + smin = 0.; + ipv = 0; + jpv = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/zgetrf2.c b/src/map/lapack2flamec/f2c/c/zgetrf2.c index 4d138306b..9bea9ce9c 100644 --- a/src/map/lapack2flamec/f2c/c/zgetrf2.c +++ b/src/map/lapack2flamec/f2c/c/zgetrf2.c @@ -128,7 +128,7 @@ int zgetrf2_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ip int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ int zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); @@ -156,6 +156,7 @@ int zgetrf2_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ip /* Parameter adjustments */ #if AOCL_FLA_PROGRESS_H AOCL_FLA_PROGRESS_VAR; + static TLS_CLASS_SPEC integer progress_size = 0; #endif a_dim1 = *lda; a_offset = 1 + a_dim1; @@ -178,7 +179,7 @@ int zgetrf2_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ip if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRF2", &i__1); + xerbla_("ZGETRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -266,24 +267,22 @@ int zgetrf2_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ip #endif if(aocl_fla_progress_ptr) { - if(step_count == 0 || step_count==size ){ - size=fla_min(*m,*n); - step_count =1; + if(progress_step_count == 0 || progress_step_count == progress_size ){ + progress_size = fla_min(*m,*n); + progress_step_count =1; } - if(!(step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) + if(!(progress_step_count == 1 &&(*m < FLA_GETRF_SMALL && *n < FLA_GETRF_SMALL))) { - - - ++step_count; - if((step_count%8)==0 || step_count==size) + ++progress_step_count; + if((progress_step_count%8)==0 || progress_step_count == progress_size) { - AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF2",7,&step_count,&thread_id,&total_threads); + AOCL_FLA_PROGRESS_FUNC_PTR("ZGETRF2",7,&progress_step_count,&progress_thread_id,&progress_total_threads); } } } - #endif + #endif zgetrf2_(m, &n1, &a[a_offset], lda, &ipiv[1], &iinfo); if (*info == 0 && iinfo > 0) diff --git a/src/map/lapack2flamec/f2c/c/zgetri.c b/src/map/lapack2flamec/f2c/c/zgetri.c index 8d1624a47..5893cd567 100644 --- a/src/map/lapack2flamec/f2c/c/zgetri.c +++ b/src/map/lapack2flamec/f2c/c/zgetri.c @@ -123,7 +123,7 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom /* Local variables */ integer i__, j, jb, nb, jj, jp, nn, iws, nbmin; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -178,7 +178,7 @@ int zgetri_(integer *n, doublecomplex *a, integer *lda, integer *ipiv, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRI", &i__1); + xerbla_("ZGETRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgetrs.c b/src/map/lapack2flamec/f2c/c/zgetrs.c index b45708419..544ba773e 100644 --- a/src/map/lapack2flamec/f2c/c/zgetrs.c +++ b/src/map/lapack2flamec/f2c/c/zgetrs.c @@ -126,7 +126,7 @@ int zgetrs_(char *trans, integer *n, integer *nrhs, doublecomplex *a, integer *l /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); @@ -185,7 +185,7 @@ int zgetrs_(char *trans, integer *n, integer *nrhs, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETRS", &i__1); + xerbla_("ZGETRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgetsls.c b/src/map/lapack2flamec/f2c/c/zgetsls.c index 4f5f1c966..c55d440de 100644 --- a/src/map/lapack2flamec/f2c/c/zgetsls.c +++ b/src/map/lapack2flamec/f2c/c/zgetsls.c @@ -190,7 +190,7 @@ int zgetsls_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex int dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer scllen; doublereal bignum; extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); @@ -319,7 +319,7 @@ int zgetsls_(char *trans, integer *m, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETSLS", &i__1); + xerbla_("ZGETSLS", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgetsqrhrt.c b/src/map/lapack2flamec/f2c/c/zgetsqrhrt.c index 1d5bc2dd8..94f70a6e2 100644 --- a/src/map/lapack2flamec/f2c/c/zgetsqrhrt.c +++ b/src/map/lapack2flamec/f2c/c/zgetsqrhrt.c @@ -180,7 +180,7 @@ int zgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 int zunhr_col_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); integer lw1, lw2, num_all_row_blocks__, lwt, ldwt, iinfo; extern /* Subroutine */ - int zungtsqr_row_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zungtsqr_row_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; integer nb1local, nb2local; extern /* Subroutine */ @@ -299,7 +299,7 @@ int zgetsqrhrt_(integer *m, integer *n, integer *mb1, integer *nb1, integer *nb2 if (*info != 0) { i__1 = -(*info); - xerbla_("ZGETSQRHRT", &i__1); + xerbla_("ZGETSQRHRT", &i__1, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggbak.c b/src/map/lapack2flamec/f2c/c/zggbak.c index 869948546..1e9c38758 100644 --- a/src/map/lapack2flamec/f2c/c/zggbak.c +++ b/src/map/lapack2flamec/f2c/c/zggbak.c @@ -149,7 +149,7 @@ int zggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl extern logical lsame_(char *, char *); logical leftv; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); logical rightv; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -219,7 +219,7 @@ int zggbak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGBAK", &i__1); + xerbla_("ZGGBAK", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggbal.c b/src/map/lapack2flamec/f2c/c/zggbal.c index ce601f495..946cea239 100644 --- a/src/map/lapack2flamec/f2c/c/zggbal.c +++ b/src/map/lapack2flamec/f2c/c/zggbal.c @@ -207,7 +207,7 @@ int zggbal_(char *job, integer *n, doublecomplex *a, integer *lda, doublecomplex extern doublereal dlamch_(char *); doublereal pgamma; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); integer lsfmin; extern integer izamax_(integer *, doublecomplex *, integer *); integer lsfmax; @@ -267,7 +267,7 @@ int zggbal_(char *job, integer *n, doublecomplex *a, integer *lda, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGBAL", &i__1); + xerbla_("ZGGBAL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgges.c b/src/map/lapack2flamec/f2c/c/zgges.c index e9d4b3bcb..004fb91ed 100644 --- a/src/map/lapack2flamec/f2c/c/zgges.c +++ b/src/map/lapack2flamec/f2c/c/zgges.c @@ -272,7 +272,7 @@ the routine */ /* > \ingroup complex16GEeigen */ /* ===================================================================== */ /* Subroutine */ -int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex * beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) +int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fpz2 selctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex * beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgges inputs: jobvsl %c, jobvsr %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS "",*jobvsl, *jobvsr, *sort, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr); @@ -298,7 +298,7 @@ int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doub int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -466,7 +466,7 @@ int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGES ", &i__1); + xerbla_("ZGGES ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgges3.c b/src/map/lapack2flamec/f2c/c/zgges3.c index bd2758a99..baedb8745 100644 --- a/src/map/lapack2flamec/f2c/c/zgges3.c +++ b/src/map/lapack2flamec/f2c/c/zgges3.c @@ -271,7 +271,7 @@ the routine */ /* > \ingroup complex16GEeigen */ /* ===================================================================== */ /* Subroutine */ -int zgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex * beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) +int zgges3_(char *jobvsl, char *jobvsr, char *sort, L_fpz2 selctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex * beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zgges3 inputs: jobvsl %c, jobvsr %c, sort %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS "",*jobvsl, *jobvsr, *sort, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr); @@ -298,7 +298,7 @@ int zgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, dou int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; integer ijobvl, iright; @@ -483,7 +483,7 @@ int zgges3_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, integer *n, dou if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGES3 ", &i__1); + xerbla_("ZGGES3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggesx.c b/src/map/lapack2flamec/f2c/c/zggesx.c index d3771f694..88fa27ab7 100644 --- a/src/map/lapack2flamec/f2c/c/zggesx.c +++ b/src/map/lapack2flamec/f2c/c/zggesx.c @@ -337,7 +337,7 @@ the */ /* > \ingroup complex16GEeigen */ /* ===================================================================== */ /* Subroutine */ -int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex *beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublereal *rconde, doublereal * rcondv, doublecomplex *work, integer *lwork, doublereal *rwork, integer *iwork, integer *liwork, logical *bwork, integer *info) +int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fpz2 selctg, char *sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex *beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublereal *rconde, doublereal * rcondv, doublecomplex *work, integer *lwork, doublereal *rwork, integer *iwork, integer *liwork, logical *bwork, integer *info) { AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zggesx inputs: jobvsl %c, jobvsr %c, sort %c, sense %c, n %" FLA_IS ", lda %" FLA_IS ", ldb %" FLA_IS ", sdim %" FLA_IS ", ldvsl %" FLA_IS ", ldvsr %" FLA_IS "",*jobvsl, *jobvsr, *sort, *sense, *n, *lda, *ldb, *sdim, *ldvsl, *ldvsr); @@ -364,7 +364,7 @@ int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -585,7 +585,7 @@ int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp selctg, char *sense, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGESX", &i__1); + xerbla_("ZGGESX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggev.c b/src/map/lapack2flamec/f2c/c/zggev.c index 2a5dac873..dc87e3585 100644 --- a/src/map/lapack2flamec/f2c/c/zggev.c +++ b/src/map/lapack2flamec/f2c/c/zggev.c @@ -247,7 +247,7 @@ int zggev_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical ldumma[1]; char chtemp[1]; @@ -414,7 +414,7 @@ int zggev_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGEV ", &i__1); + xerbla_("ZGGEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggev3.c b/src/map/lapack2flamec/f2c/c/zggev3.c index 3795e337b..d4d6a852a 100644 --- a/src/map/lapack2flamec/f2c/c/zggev3.c +++ b/src/map/lapack2flamec/f2c/c/zggev3.c @@ -246,7 +246,7 @@ int zggev3_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda int zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical ldumma[1]; char chtemp[1]; doublereal bignum; @@ -437,7 +437,7 @@ int zggev3_(char *jobvl, char *jobvr, integer *n, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGEV3 ", &i__1); + xerbla_("ZGGEV3 ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggevx.c b/src/map/lapack2flamec/f2c/c/zggevx.c index 72ea75468..b7f75209d 100644 --- a/src/map/lapack2flamec/f2c/c/zggevx.c +++ b/src/map/lapack2flamec/f2c/c/zggevx.c @@ -410,7 +410,7 @@ int zggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zggbak_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublecomplex *, integer *, integer *), zggbal_( char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); logical ilascl, ilbscl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical ldumma[1]; char chtemp[1]; @@ -615,7 +615,7 @@ int zggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGEVX", &i__1); + xerbla_("ZGGEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggglm.c b/src/map/lapack2flamec/f2c/c/zggglm.c index 8f01875d7..b10078b70 100644 --- a/src/map/lapack2flamec/f2c/c/zggglm.c +++ b/src/map/lapack2flamec/f2c/c/zggglm.c @@ -191,7 +191,7 @@ int zggglm_(integer *n, integer *m, integer *p, doublecomplex *a, integer *lda, /* Local variables */ integer i__, nb, np, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zggqrf_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *) ; @@ -285,7 +285,7 @@ int zggglm_(integer *n, integer *m, integer *p, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGGLM", &i__1); + xerbla_("ZGGGLM", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgghd3.c b/src/map/lapack2flamec/f2c/c/zgghd3.c index 5828dc38a..c7e7ad6fa 100644 --- a/src/map/lapack2flamec/f2c/c/zgghd3.c +++ b/src/map/lapack2flamec/f2c/c/zgghd3.c @@ -278,7 +278,7 @@ int zgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d int ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); char compq2[1], compz2[1]; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgghrd_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer * ), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -377,7 +377,7 @@ int zgghd3_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGHD3", &i__1); + xerbla_("ZGGHD3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgghrd.c b/src/map/lapack2flamec/f2c/c/zgghrd.c index 0d96e11c1..069a600bd 100644 --- a/src/map/lapack2flamec/f2c/c/zgghrd.c +++ b/src/map/lapack2flamec/f2c/c/zgghrd.c @@ -228,7 +228,7 @@ int zgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d extern logical lsame_(char *, char *); doublecomplex ctemp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icompq, icompz; extern /* Subroutine */ int zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *); @@ -347,7 +347,7 @@ int zgghrd_(char *compq, char *compz, integer *n, integer * ilo, integer *ihi, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGHRD", &i__1); + xerbla_("ZGGHRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgglse.c b/src/map/lapack2flamec/f2c/c/zgglse.c index 3b4d04d9e..fdb0ece8b 100644 --- a/src/map/lapack2flamec/f2c/c/zgglse.c +++ b/src/map/lapack2flamec/f2c/c/zgglse.c @@ -186,7 +186,7 @@ int zgglse_(integer *m, integer *n, integer *p, doublecomplex *a, integer *lda, /* Local variables */ integer nb, mn, nr, nb1, nb2, nb3, nb4, lopt; extern /* Subroutine */ - int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zggrqf_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *) ; @@ -281,7 +281,7 @@ int zgglse_(integer *m, integer *n, integer *p, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGLSE", &i__1); + xerbla_("ZGGLSE", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggqrf.c b/src/map/lapack2flamec/f2c/c/zggqrf.c index 1710ae218..17e7c7380 100644 --- a/src/map/lapack2flamec/f2c/c/zggqrf.c +++ b/src/map/lapack2flamec/f2c/c/zggqrf.c @@ -218,7 +218,7 @@ int zggqrf_(integer *n, integer *m, integer *p, doublecomplex *a, integer *lda, /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgeqrf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer * ), zgerqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -302,7 +302,7 @@ int zggqrf_(integer *n, integer *m, integer *p, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGQRF", &i__1); + xerbla_("ZGGQRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggrqf.c b/src/map/lapack2flamec/f2c/c/zggrqf.c index 9e4a3dde1..b06f7ce35 100644 --- a/src/map/lapack2flamec/f2c/c/zggrqf.c +++ b/src/map/lapack2flamec/f2c/c/zggrqf.c @@ -217,7 +217,7 @@ int zggrqf_(integer *m, integer *p, integer *n, doublecomplex *a, integer *lda, /* Local variables */ integer nb, nb1, nb2, nb3, lopt; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgeqrf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer * ), zgerqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -301,7 +301,7 @@ int zggrqf_(integer *m, integer *p, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGRQF", &i__1); + xerbla_("ZGGRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggsvd.c b/src/map/lapack2flamec/f2c/c/zggsvd.c index dd47fc147..090a48960 100644 --- a/src/map/lapack2flamec/f2c/c/zggsvd.c +++ b/src/map/lapack2flamec/f2c/c/zggsvd.c @@ -348,7 +348,7 @@ int zggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer extern doublereal dlamch_(char *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int ztgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zggsvp_(char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *); @@ -444,7 +444,7 @@ int zggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVD", &i__1); + xerbla_("ZGGSVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggsvd3.c b/src/map/lapack2flamec/f2c/c/zggsvd3.c index bd45bde8b..417f6fd00 100644 --- a/src/map/lapack2flamec/f2c/c/zggsvd3.c +++ b/src/map/lapack2flamec/f2c/c/zggsvd3.c @@ -368,7 +368,7 @@ int zggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer extern doublereal dlamch_(char *); integer ncycle; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int ztgsja_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -489,7 +489,7 @@ int zggsvd3_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVD3", &i__1); + xerbla_("ZGGSVD3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggsvp.c b/src/map/lapack2flamec/f2c/c/zggsvp.c index b8812069b..33a072652 100644 --- a/src/map/lapack2flamec/f2c/c/zggsvp.c +++ b/src/map/lapack2flamec/f2c/c/zggsvp.c @@ -281,7 +281,7 @@ int zggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgerq2_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *), zgeqpf_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, doublereal *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgerq2_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgeqpf_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, doublereal *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical forwrd; extern /* Subroutine */ int zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlapmt_(logical *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -383,7 +383,7 @@ int zggsvp_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVP", &i__1); + xerbla_("ZGGSVP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zggsvp3.c b/src/map/lapack2flamec/f2c/c/zggsvp3.c index 91b686b9c..99b3def01 100644 --- a/src/map/lapack2flamec/f2c/c/zggsvp3.c +++ b/src/map/lapack2flamec/f2c/c/zggsvp3.c @@ -297,7 +297,7 @@ int zggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer extern logical lsame_(char *, char *); logical wantq, wantu, wantv; extern /* Subroutine */ - int zgeqp3_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublereal *, integer *), zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgerq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int zgeqp3_(integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublereal *, integer *), zgeqr2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgerq2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical forwrd; extern /* Subroutine */ int zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlapmt_(logical *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -433,7 +433,7 @@ int zggsvp3_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZGGSVP3", &i__1); + xerbla_("ZGGSVP3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgsvj0.c b/src/map/lapack2flamec/f2c/c/zgsvj0.c index 2ca35c786..13cf02628 100644 --- a/src/map/lapack2flamec/f2c/c/zgsvj0.c +++ b/src/map/lapack2flamec/f2c/c/zgsvj0.c @@ -245,7 +245,7 @@ int zgsvj0_(char *jobv, integer *m, integer *n, doublecomplex *a, integer *lda, extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband, blskip; doublereal mxaapq; extern /* Subroutine */ @@ -340,7 +340,7 @@ int zgsvj0_(char *jobv, integer *m, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZGSVJ0", &i__1); + xerbla_("ZGSVJ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgsvj1.c b/src/map/lapack2flamec/f2c/c/zgsvj1.c index be5722ca3..0bfad47ac 100644 --- a/src/map/lapack2flamec/f2c/c/zgsvj1.c +++ b/src/map/lapack2flamec/f2c/c/zgsvj1.c @@ -262,7 +262,7 @@ int zgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublecomplex *a, i extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer ijblsk, swband, blskip; doublereal mxaapq; extern /* Subroutine */ @@ -359,7 +359,7 @@ int zgsvj1_(char *jobv, integer *m, integer *n, integer *n1, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZGSVJ1", &i__1); + xerbla_("ZGSVJ1", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgtcon.c b/src/map/lapack2flamec/f2c/c/zgtcon.c index a592ddce6..ae33ac6ac 100644 --- a/src/map/lapack2flamec/f2c/c/zgtcon.c +++ b/src/map/lapack2flamec/f2c/c/zgtcon.c @@ -143,7 +143,7 @@ int zgtcon_(char *norm, integer *n, doublecomplex *dl, doublecomplex *d__, doubl extern logical lsame_(char *, char *); integer isave[3]; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; logical onenrm; extern /* Subroutine */ @@ -196,7 +196,7 @@ int zgtcon_(char *norm, integer *n, doublecomplex *dl, doublecomplex *d__, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("ZGTCON", &i__1); + xerbla_("ZGTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgtrfs.c b/src/map/lapack2flamec/f2c/c/zgtrfs.c index 97deabfe8..3eb689fa8 100644 --- a/src/map/lapack2flamec/f2c/c/zgtrfs.c +++ b/src/map/lapack2flamec/f2c/c/zgtrfs.c @@ -229,7 +229,7 @@ int zgtrfs_(char *trans, integer *n, integer *nrhs, doublecomplex *dl, doublecom extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), zlagtm_( char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlagtm_( char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); logical notran; char transn[1], transt[1]; doublereal lstres; @@ -307,7 +307,7 @@ int zgtrfs_(char *trans, integer *n, integer *nrhs, doublecomplex *dl, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZGTRFS", &i__1); + xerbla_("ZGTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgtsv.c b/src/map/lapack2flamec/f2c/c/zgtsv.c index 68d8ddef8..91fbb556b 100644 --- a/src/map/lapack2flamec/f2c/c/zgtsv.c +++ b/src/map/lapack2flamec/f2c/c/zgtsv.c @@ -126,7 +126,7 @@ int zgtsv_(integer *n, integer *nrhs, doublecomplex *dl, doublecomplex *d__, dou integer j, k; doublecomplex temp, mult; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -173,7 +173,7 @@ int zgtsv_(integer *n, integer *nrhs, doublecomplex *dl, doublecomplex *d__, dou if (*info != 0) { i__1 = -(*info); - xerbla_("ZGTSV ", &i__1); + xerbla_("ZGTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgtsvx.c b/src/map/lapack2flamec/f2c/c/zgtsvx.c index 4a8ecd719..9f19e76fa 100644 --- a/src/map/lapack2flamec/f2c/c/zgtsvx.c +++ b/src/map/lapack2flamec/f2c/c/zgtsvx.c @@ -298,7 +298,7 @@ int zgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex * extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlangt_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *); logical notran; extern /* Subroutine */ @@ -373,7 +373,7 @@ int zgtsvx_(char *fact, char *trans, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZGTSVX", &i__1); + xerbla_("ZGTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgttrf.c b/src/map/lapack2flamec/f2c/c/zgttrf.c index 28fd7de8c..3ce9ec806 100644 --- a/src/map/lapack2flamec/f2c/c/zgttrf.c +++ b/src/map/lapack2flamec/f2c/c/zgttrf.c @@ -128,7 +128,7 @@ int zgttrf_(integer *n, doublecomplex *dl, doublecomplex * d__, doublecomplex *d integer i__; doublecomplex fact, temp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,7 +163,7 @@ int zgttrf_(integer *n, doublecomplex *dl, doublecomplex * d__, doublecomplex *d { *info = -1; i__1 = -(*info); - xerbla_("ZGTTRF", &i__1); + xerbla_("ZGTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zgttrs.c b/src/map/lapack2flamec/f2c/c/zgttrs.c index f3bb46473..a6dec95c7 100644 --- a/src/map/lapack2flamec/f2c/c/zgttrs.c +++ b/src/map/lapack2flamec/f2c/c/zgttrs.c @@ -138,7 +138,7 @@ int zgttrs_(char *trans, integer *n, integer *nrhs, doublecomplex *dl, doublecom /* Local variables */ integer j, jb, nb; extern /* Subroutine */ - int zgtts2_(integer *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgtts2_(integer *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer itrans; logical notran; @@ -191,7 +191,7 @@ int zgttrs_(char *trans, integer *n, integer *nrhs, doublecomplex *dl, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZGTTRS", &i__1); + xerbla_("ZGTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhb2st_kernels.c b/src/map/lapack2flamec/f2c/c/zhb2st_kernels.c index 9d27731c8..cdc7c6afc 100644 --- a/src/map/lapack2flamec/f2c/c/zhb2st_kernels.c +++ b/src/map/lapack2flamec/f2c/c/zhb2st_kernels.c @@ -173,7 +173,6 @@ int zhb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in integer dpos, vpos; extern logical lsame_(char *, char *); logical upper; - integer ajeter; extern /* Subroutine */ int zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); integer ofdpos; @@ -208,7 +207,6 @@ int zhb2st_kernels_(char *uplo, logical *wantz, integer * ttype, integer *st, in --tau; --work; /* Function Body */ - ajeter = *ib + *ldvt; upper = lsame_(uplo, "U"); if (upper) { diff --git a/src/map/lapack2flamec/f2c/c/zhbev.c b/src/map/lapack2flamec/f2c/c/zhbev.c index 1f33a6cd7..94c071fdd 100644 --- a/src/map/lapack2flamec/f2c/c/zhbev.c +++ b/src/map/lapack2flamec/f2c/c/zhbev.c @@ -170,7 +170,7 @@ int zhbev_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex *ab, i doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -240,7 +240,7 @@ int zhbev_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex *ab, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEV ", &i__1); + xerbla_("ZHBEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbev_2stage.c b/src/map/lapack2flamec/f2c/c/zhbev_2stage.c index dea3f9643..5412a406d 100644 --- a/src/map/lapack2flamec/f2c/c/zhbev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhbev_2stage.c @@ -238,7 +238,7 @@ int zhbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -333,7 +333,7 @@ int zhbev_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEV_2STAGE ", &i__1); + xerbla_("ZHBEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbevd.c b/src/map/lapack2flamec/f2c/c/zhbevd.c index 96401cee8..aa3c60a01 100644 --- a/src/map/lapack2flamec/f2c/c/zhbevd.c +++ b/src/map/lapack2flamec/f2c/c/zhbevd.c @@ -253,7 +253,7 @@ int zhbevd_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex *ab, doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *), zstedc_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -371,7 +371,7 @@ int zhbevd_(char *jobz, char *uplo, integer *n, integer *kd, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEVD", &i__1); + xerbla_("ZHBEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbevd_2stage.c b/src/map/lapack2flamec/f2c/c/zhbevd_2stage.c index 359b00bce..cdbfdb762 100644 --- a/src/map/lapack2flamec/f2c/c/zhbevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhbevd_2stage.c @@ -303,7 +303,7 @@ int zhbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublecomple doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *), zstedc_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *); @@ -428,7 +428,7 @@ int zhbevd_2stage_(char *jobz, char *uplo, integer *n, integer *kd, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEVD_2STAGE", &i__1); + xerbla_("ZHBEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbevx.c b/src/map/lapack2flamec/f2c/c/zhbevx.c index 407ef68ab..33d69f848 100644 --- a/src/map/lapack2flamec/f2c/c/zhbevx.c +++ b/src/map/lapack2flamec/f2c/c/zhbevx.c @@ -304,7 +304,7 @@ int zhbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, double doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indiwk, indisp; extern /* Subroutine */ @@ -418,7 +418,7 @@ int zhbevx_(char *jobz, char *range, char *uplo, integer *n, integer *kd, double if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEVX", &i__1); + xerbla_("ZHBEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbevx_2stage.c b/src/map/lapack2flamec/f2c/c/zhbevx_2stage.c index 45e26df2b..96cbeef24 100644 --- a/src/map/lapack2flamec/f2c/c/zhbevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhbevx_2stage.c @@ -380,7 +380,7 @@ int zhbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, doublereal safmin; extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal abstll, bignum; integer indiwk, indisp; extern /* Subroutine */ @@ -521,7 +521,7 @@ int zhbevx_2stage_(char *jobz, char *range, char *uplo, integer *n, integer *kd, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBEVX_2STAGE", &i__1); + xerbla_("ZHBEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbgst.c b/src/map/lapack2flamec/f2c/c/zhbgst.c index 1c4c9dee4..3a4b4b58a 100644 --- a/src/map/lapack2flamec/f2c/c/zhbgst.c +++ b/src/map/lapack2flamec/f2c/c/zhbgst.c @@ -196,7 +196,7 @@ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, double int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical wantx; extern /* Subroutine */ - int zlar2v_(integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int zlar2v_(integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); logical update; extern /* Subroutine */ int zlacgv_(integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_( doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *), zlartv_( integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); @@ -239,6 +239,7 @@ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, double ka1 = *ka + 1; kb1 = *kb + 1; *info = 0; + j2 = 0; if (! wantx && ! lsame_(vect, "N")) { *info = -1; @@ -274,7 +275,7 @@ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka, integer *kb, double if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBGST", &i__1); + xerbla_("ZHBGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbgv.c b/src/map/lapack2flamec/f2c/c/zhbgv.c index ecf673767..842b2c94b 100644 --- a/src/map/lapack2flamec/f2c/c/zhbgv.c +++ b/src/map/lapack2flamec/f2c/c/zhbgv.c @@ -186,7 +186,7 @@ int zhbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, doublec integer iinfo; logical upper, wantz; extern /* Subroutine */ - int xerbla_(char *, integer *), dsterf_( integer *, doublereal *, doublereal *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dsterf_( integer *, doublereal *, doublereal *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); integer indwrk; extern /* Subroutine */ int zhbgst_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *, integer *), zpbstf_(char *, integer *, integer *, doublecomplex *, integer *, integer *), zsteqr_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublereal *, integer *); @@ -259,7 +259,7 @@ int zhbgv_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBGV ", &i__1); + xerbla_("ZHBGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbgvd.c b/src/map/lapack2flamec/f2c/c/zhbgvd.c index 369794cc4..294072214 100644 --- a/src/map/lapack2flamec/f2c/c/zhbgvd.c +++ b/src/map/lapack2flamec/f2c/c/zhbgvd.c @@ -274,7 +274,7 @@ int zhbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, double logical wantz; integer indwk2; extern /* Subroutine */ - int xerbla_(char *, integer *), dsterf_( integer *, doublereal *, doublereal *, integer *), zstedc_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dsterf_( integer *, doublereal *, doublereal *, integer *), zstedc_(char *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); integer indwrk, liwmin; extern /* Subroutine */ int zhbgst_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -396,7 +396,7 @@ int zhbgvd_(char *jobz, char *uplo, integer *n, integer *ka, integer *kb, double if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBGVD", &i__1); + xerbla_("ZHBGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbgvx.c b/src/map/lapack2flamec/f2c/c/zhbgvx.c index e3419bc6e..0cb5108bd 100644 --- a/src/map/lapack2flamec/f2c/c/zhbgvx.c +++ b/src/map/lapack2flamec/f2c/c/zhbgvx.c @@ -318,7 +318,7 @@ int zhbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege integer indibl; logical valeig; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer indiwk, indisp; extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *, integer *), dstebz_(char *, char *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), zhbtrd_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -441,7 +441,7 @@ int zhbgvx_(char *jobz, char *range, char *uplo, integer *n, integer *ka, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBGVX", &i__1); + xerbla_("ZHBGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhbtrd.c b/src/map/lapack2flamec/f2c/c/zhbtrd.c index fe76cbb50..f03fc0b81 100644 --- a/src/map/lapack2flamec/f2c/c/zhbtrd.c +++ b/src/map/lapack2flamec/f2c/c/zhbtrd.c @@ -199,7 +199,7 @@ int zhbtrd_(char *vect, char *uplo, integer *n, integer *kd, doublecomplex *ab, int zlar2v_(integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); integer iqaend; extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *), zlartv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *), zlargv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *), zlartv_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -267,7 +267,7 @@ int zhbtrd_(char *vect, char *uplo, integer *n, integer *kd, doublecomplex *ab, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHBTRD", &i__1); + xerbla_("ZHBTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhecon.c b/src/map/lapack2flamec/f2c/c/zhecon.c index 8fe163a48..f236aa572 100644 --- a/src/map/lapack2flamec/f2c/c/zhecon.c +++ b/src/map/lapack2flamec/f2c/c/zhecon.c @@ -126,7 +126,7 @@ int zhecon_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -181,7 +181,7 @@ int zhecon_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZHECON", &i__1); + xerbla_("ZHECON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhecon_3.c b/src/map/lapack2flamec/f2c/c/zhecon_3.c index 0b1ddb4c0..3152c98b2 100644 --- a/src/map/lapack2flamec/f2c/c/zhecon_3.c +++ b/src/map/lapack2flamec/f2c/c/zhecon_3.c @@ -169,7 +169,7 @@ int zhecon_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -223,7 +223,7 @@ int zhecon_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZHECON_3", &i__1); + xerbla_("ZHECON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhecon_rook.c b/src/map/lapack2flamec/f2c/c/zhecon_rook.c index 47f9a56f2..91d24d339 100644 --- a/src/map/lapack2flamec/f2c/c/zhecon_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhecon_rook.c @@ -141,7 +141,7 @@ int zhecon_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -194,7 +194,7 @@ int zhecon_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHECON_ROOK", &i__1); + xerbla_("ZHECON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheequb.c b/src/map/lapack2flamec/f2c/c/zheequb.c index 1483b6036..2d80d240a 100644 --- a/src/map/lapack2flamec/f2c/c/zheequb.c +++ b/src/map/lapack2flamec/f2c/c/zheequb.c @@ -142,7 +142,7 @@ int zheequb_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal doublereal sumsq; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; extern /* Subroutine */ int zlassq_(integer *, doublecomplex *, integer *, doublereal *, doublereal *); @@ -193,7 +193,7 @@ int zheequb_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEQUB", &i__1); + xerbla_("ZHEEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheev.c b/src/map/lapack2flamec/f2c/c/zheev.c index 5f50eec83..16d64c0a5 100644 --- a/src/map/lapack2flamec/f2c/c/zheev.c +++ b/src/map/lapack2flamec/f2c/c/zheev.c @@ -161,7 +161,7 @@ int zheev_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda, d doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indtau; @@ -245,7 +245,7 @@ int zheev_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEV ", &i__1); + xerbla_("ZHEEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheev_2stage.c b/src/map/lapack2flamec/f2c/c/zheev_2stage.c index a6f1fe91e..623d662b7 100644 --- a/src/map/lapack2flamec/f2c/c/zheev_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zheev_2stage.c @@ -215,7 +215,7 @@ int zheev_2stage_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indtau; @@ -293,7 +293,7 @@ int zheev_2stage_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEV_2STAGE ", &i__1); + xerbla_("ZHEEV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevd.c b/src/map/lapack2flamec/f2c/c/zheevd.c index aaa6a5edc..3a221b173 100644 --- a/src/map/lapack2flamec/f2c/c/zheevd.c +++ b/src/map/lapack2flamec/f2c/c/zheevd.c @@ -231,7 +231,7 @@ int zheevd_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indtau; @@ -349,7 +349,7 @@ int zheevd_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVD", &i__1); + xerbla_("ZHEEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevd_2stage.c b/src/map/lapack2flamec/f2c/c/zheevd_2stage.c index 966109fd6..e36308720 100644 --- a/src/map/lapack2flamec/f2c/c/zheevd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zheevd_2stage.c @@ -281,7 +281,7 @@ int zheevd_2stage_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indtau; @@ -395,7 +395,7 @@ int zheevd_2stage_(char *jobz, char *uplo, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVD_2STAGE", &i__1); + xerbla_("ZHEEVD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevr.c b/src/map/lapack2flamec/f2c/c/zheevr.c index 8f7dcef16..7ec7e317f 100644 --- a/src/map/lapack2flamec/f2c/c/zheevr.c +++ b/src/map/lapack2flamec/f2c/c/zheevr.c @@ -383,7 +383,7 @@ int zheevr_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *a, i doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -537,7 +537,7 @@ int zheevr_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVR", &i__1); + xerbla_("ZHEEVR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevr_2stage.c b/src/map/lapack2flamec/f2c/c/zheevr_2stage.c index 9cf8f3788..8c3527792 100644 --- a/src/map/lapack2flamec/f2c/c/zheevr_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zheevr_2stage.c @@ -444,7 +444,7 @@ int zheevr_2stage_(char *jobz, char *range, char *uplo, integer *n, doublecomple doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal abstll, bignum; integer indtau, indisp; extern /* Subroutine */ @@ -588,7 +588,7 @@ int zheevr_2stage_(char *jobz, char *range, char *uplo, integer *n, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVR_2STAGE", &i__1); + xerbla_("ZHEEVR_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevx.c b/src/map/lapack2flamec/f2c/c/zheevx.c index 36b015644..d3f49350c 100644 --- a/src/map/lapack2flamec/f2c/c/zheevx.c +++ b/src/map/lapack2flamec/f2c/c/zheevx.c @@ -281,7 +281,7 @@ int zheevx_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *a, i doublereal safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal abstll, bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indiwk, indisp, indtau; @@ -342,6 +342,7 @@ int zheevx_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *a, i indeig = lsame_(range, "I"); lquery = *lwork == -1; *info = 0; + lwkopt = 0; if (! (wantz || lsame_(jobz, "N"))) { *info = -1; @@ -421,7 +422,7 @@ int zheevx_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVX", &i__1); + xerbla_("ZHEEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zheevx_2stage.c b/src/map/lapack2flamec/f2c/c/zheevx_2stage.c index ce4eab100..4d9c76f86 100644 --- a/src/map/lapack2flamec/f2c/c/zheevx_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zheevx_2stage.c @@ -342,7 +342,7 @@ int zheevx_2stage_(char *jobz, char *range, char *uplo, integer *n, doublecomple logical valeig; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal abstll, bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); integer indiwk, indisp, indtau; @@ -474,7 +474,7 @@ int zheevx_2stage_(char *jobz, char *range, char *uplo, integer *n, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEEVX_2STAGE", &i__1); + xerbla_("ZHEEVX_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhegv.c b/src/map/lapack2flamec/f2c/c/zhegv.c index 565954400..fd4a09830 100644 --- a/src/map/lapack2flamec/f2c/c/zhegv.c +++ b/src/map/lapack2flamec/f2c/c/zhegv.c @@ -194,7 +194,7 @@ int zhegv_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex *a char trans[1]; logical upper, wantz; extern /* Subroutine */ - int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -282,7 +282,7 @@ int zhegv_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGV ", &i__1); + xerbla_("ZHEGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhegv_2stage.c b/src/map/lapack2flamec/f2c/c/zhegv_2stage.c index 89784e7ff..73ef8aeec 100644 --- a/src/map/lapack2flamec/f2c/c/zhegv_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhegv_2stage.c @@ -250,7 +250,7 @@ int zhegv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, doublecomp integer lwtrd; logical wantz; extern /* Subroutine */ - int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); logical lquery; extern /* Subroutine */ int zpotrf_(char *, integer *, doublecomplex *, integer *, integer *); @@ -331,7 +331,7 @@ int zhegv_2stage_(integer *itype, char *jobz, char *uplo, integer *n, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGV_2STAGE ", &i__1); + xerbla_("ZHEGV_2STAGE ", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhegvd.c b/src/map/lapack2flamec/f2c/c/zhegvd.c index eec7cd4f8..6ca955b38 100644 --- a/src/map/lapack2flamec/f2c/c/zhegvd.c +++ b/src/map/lapack2flamec/f2c/c/zhegvd.c @@ -265,7 +265,7 @@ int zhegvd_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex * integer lropt; logical wantz; extern /* Subroutine */ - int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zheevd_(char *, char *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *); + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zheevd_(char *, char *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *); integer liwmin; extern /* Subroutine */ int zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -377,7 +377,7 @@ int zhegvd_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGVD", &i__1); + xerbla_("ZHEGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhegvx.c b/src/map/lapack2flamec/f2c/c/zhegvx.c index 8f49a1b73..b9aad2d38 100644 --- a/src/map/lapack2flamec/f2c/c/zhegvx.c +++ b/src/map/lapack2flamec/f2c/c/zhegvx.c @@ -311,7 +311,7 @@ int zhegvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); logical alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zheevx_(char *, char *, char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *); @@ -439,7 +439,7 @@ int zhegvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZHEGVX", &i__1); + xerbla_("ZHEGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zherfs.c b/src/map/lapack2flamec/f2c/c/zherfs.c index 1f55c98d6..69edecdcd 100644 --- a/src/map/lapack2flamec/f2c/c/zherfs.c +++ b/src/map/lapack2flamec/f2c/c/zherfs.c @@ -212,7 +212,7 @@ int zherfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -295,7 +295,7 @@ int zherfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZHERFS", &i__1); + xerbla_("ZHERFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zherfsx.c b/src/map/lapack2flamec/f2c/c/zherfsx.c index 9703bda5e..7836d83d1 100644 --- a/src/map/lapack2flamec/f2c/c/zherfsx.c +++ b/src/map/lapack2flamec/f2c/c/zherfsx.c @@ -419,7 +419,7 @@ int zherfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex logical rcequ; extern doublereal zla_hercond_c_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, logical *, integer *, doublecomplex *, doublereal *), zla_hercond_x_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zhecon_(char *, integer *, doublecomplex *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *); @@ -569,7 +569,7 @@ int zherfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZHERFSX", &i__1); + xerbla_("ZHERFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesv.c b/src/map/lapack2flamec/f2c/c/zhesv.c index 05172859e..4846d14d6 100644 --- a/src/map/lapack2flamec/f2c/c/zhesv.c +++ b/src/map/lapack2flamec/f2c/c/zhesv.c @@ -172,7 +172,7 @@ int zhesv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda integer nb; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zhetrf_(char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -252,7 +252,7 @@ int zhesv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESV ", &i__1); + xerbla_("ZHESV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesv_aa.c b/src/map/lapack2flamec/f2c/c/zhesv_aa.c index 7f806511e..b4a4c744d 100644 --- a/src/map/lapack2flamec/f2c/c/zhesv_aa.c +++ b/src/map/lapack2flamec/f2c/c/zhesv_aa.c @@ -163,7 +163,7 @@ int zhesv_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * integer lwkopt_hetrf__, lwkopt_hetrs__; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -240,7 +240,7 @@ int zhesv_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESV_AA ", &i__1); + xerbla_("ZHESV_AA ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zhesv_aa_2stage.c index 2f7804f87..2a42875d8 100644 --- a/src/map/lapack2flamec/f2c/c/zhesv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhesv_aa_2stage.c @@ -188,7 +188,7 @@ int zhesv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, in extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -263,7 +263,7 @@ int zhesv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESV_AA_2STAGE", &i__1); + xerbla_("ZHESV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesv_rk.c b/src/map/lapack2flamec/f2c/c/zhesv_rk.c index 892ff1c6c..c736e157a 100644 --- a/src/map/lapack2flamec/f2c/c/zhesv_rk.c +++ b/src/map/lapack2flamec/f2c/c/zhesv_rk.c @@ -229,7 +229,7 @@ int zhesv_rk_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * int zhetrs_3_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zhetrf_rk_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.7.0) -- */ @@ -305,7 +305,7 @@ int zhesv_rk_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESV_RK ", &i__1); + xerbla_("ZHESV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesv_rook.c b/src/map/lapack2flamec/f2c/c/zhesv_rook.c index 6d6dd8bd0..0e58d29b0 100644 --- a/src/map/lapack2flamec/f2c/c/zhesv_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhesv_rook.c @@ -206,7 +206,7 @@ int zhesv_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer int zhetrf_rook_(char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zhetrs_rook_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -282,7 +282,7 @@ int zhesv_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESV_ROOK ", &i__1); + xerbla_("ZHESV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesvx.c b/src/map/lapack2flamec/f2c/c/zhesvx.c index 6016a7322..d8efebcb1 100644 --- a/src/map/lapack2flamec/f2c/c/zhesvx.c +++ b/src/map/lapack2flamec/f2c/c/zhesvx.c @@ -287,7 +287,7 @@ int zhesvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ @@ -399,7 +399,7 @@ int zhesvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESVX", &i__1); + xerbla_("ZHESVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhesvxx.c b/src/map/lapack2flamec/f2c/c/zhesvxx.c index e0359f8d0..c465ad2b8 100644 --- a/src/map/lapack2flamec/f2c/c/zhesvxx.c +++ b/src/map/lapack2flamec/f2c/c/zhesvxx.c @@ -517,7 +517,7 @@ int zhesvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int zlaqhe_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, char *); @@ -669,7 +669,7 @@ int zhesvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHESVXX", &i__1); + xerbla_("ZHESVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetd2.c b/src/map/lapack2flamec/f2c/c/zhetd2.c index 2cad0fc7d..291663be4 100644 --- a/src/map/lapack2flamec/f2c/c/zhetd2.c +++ b/src/map/lapack2flamec/f2c/c/zhetd2.c @@ -192,7 +192,7 @@ int zhetd2_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * int zhemv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -239,7 +239,7 @@ int zhetd2_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETD2", &i__1); + xerbla_("ZHETD2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetf2.c b/src/map/lapack2flamec/f2c/c/zhetf2.c index ac5fba396..9fddd4176 100644 --- a/src/map/lapack2flamec/f2c/c/zhetf2.c +++ b/src/map/lapack2flamec/f2c/c/zhetf2.c @@ -213,7 +213,7 @@ int zhetf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi doublereal absakk; extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -250,6 +250,7 @@ int zhetf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -265,7 +266,7 @@ int zhetf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETF2", &i__1); + xerbla_("ZHETF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetf2_rk.c b/src/map/lapack2flamec/f2c/c/zhetf2_rk.c index 60393d9ae..3bb358951 100644 --- a/src/map/lapack2flamec/f2c/c/zhetf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/zhetf2_rk.c @@ -267,7 +267,7 @@ int zhetf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -305,6 +305,8 @@ int zhetf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -320,7 +322,7 @@ int zhetf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETF2_RK", &i__1); + xerbla_("ZHETF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -1290,4 +1292,3 @@ int zhetf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom /* End of ZHETF2_RK */ } /* zhetf2_rk__ */ - diff --git a/src/map/lapack2flamec/f2c/c/zhetf2_rook.c b/src/map/lapack2flamec/f2c/c/zhetf2_rook.c index 96205a27a..463119bdb 100644 --- a/src/map/lapack2flamec/f2c/c/zhetf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhetf2_rook.c @@ -217,7 +217,7 @@ int zhetf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -254,6 +254,8 @@ int zhetf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; + jmax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -269,7 +271,7 @@ int zhetf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETF2_ROOK", &i__1); + xerbla_("ZHETF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrd.c b/src/map/lapack2flamec/f2c/c/zhetrd.c index f618c9c94..9c82fbc6e 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrd.c +++ b/src/map/lapack2flamec/f2c/c/zhetrd.c @@ -202,7 +202,7 @@ int zhetrd_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zhetd2_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zhetd2_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlatrd_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *); @@ -268,7 +268,7 @@ int zhetrd_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD", &i__1); + xerbla_("ZHETRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrd_2stage.c b/src/map/lapack2flamec/f2c/c/zhetrd_2stage.c index 063977ecb..a5260b20c 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrd_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhetrd_2stage.c @@ -235,9 +235,9 @@ int zhetrd_2stage_(char *vect, char *uplo, integer *n, doublecomplex *a, integer integer lwrk, wpos; extern logical lsame_(char *, char *); integer abpos, lhmin, lwmin; - logical wantq, upper; + logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -268,7 +268,6 @@ int zhetrd_2stage_(char *vect, char *uplo, integer *n, doublecomplex *a, integer --work; /* Function Body */ *info = 0; - wantq = lsame_(vect, "V"); upper = lsame_(uplo, "U"); lquery = *lwork == -1 || *lhous2 == -1; /* Determine the block size, the workspace size and the hous size. */ @@ -312,7 +311,7 @@ int zhetrd_2stage_(char *vect, char *uplo, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD_2STAGE", &i__1); + xerbla_("ZHETRD_2STAGE", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -338,7 +337,7 @@ int zhetrd_2stage_(char *vect, char *uplo, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD_HE2HB", &i__1); + xerbla_("ZHETRD_HE2HB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -346,7 +345,7 @@ int zhetrd_2stage_(char *vect, char *uplo, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD_HB2ST", &i__1); + xerbla_("ZHETRD_HB2ST", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrd_hb2st.c b/src/map/lapack2flamec/f2c/c/zhetrd_hb2st.c index 95fc6c479..b1918d92f 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrd_hb2st.c +++ b/src/map/lapack2flamec/f2c/c/zhetrd_hb2st.c @@ -1,11 +1,12 @@ /* ../netlib/v3.9.0/zhetrd_hb2st.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ +#ifdef FLA_OPENMP_MULTITHREADING +#include +#endif static doublecomplex c_b1 = -{ - 0.,0. -} -; + { + 0., 0.}; static integer c__2 = 2; static integer c_n1 = -1; static integer c__3 = 3; @@ -68,7 +69,7 @@ static integer c__4 = 4; /* > VECT is CHARACTER*1 */ /* > = 'N': No need for the Housholder representation, */ /* > and thus LHOUS is of size fla_max(1, 4*N); -*/ + */ /* > = 'V': the Householder representation is needed to */ /* > either generate or to apply Q later on, */ /* > then LHOUS is to be queried and computed. */ @@ -79,7 +80,7 @@ static integer c__4 = 4; /* > \verbatim */ /* > UPLO is CHARACTER*1 */ /* > = 'U': Upper triangle of A is stored; -*/ + */ /* > = 'L': Lower triangle of A is stored. */ /* > \endverbatim */ /* > */ @@ -104,7 +105,7 @@ static integer c__4 = 4; /* > j-th column of A is stored in the j-th column of the array AB */ /* > as follows: */ /* > if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for fla_max(1,j-kd)<=i<=j; -*/ + */ /* > if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=fla_min(n,j+kd). */ /* > On exit, the diagonal elements of AB are overwritten by the */ /* > diagonal elements of the tridiagonal matrix T; @@ -241,29 +242,32 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, /* Builtin functions */ double z_abs(doublecomplex *); /* Local variables */ - integer abofdpos, nthreads, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv; + integer abofdpos, i__, k, m, stepercol, ed, ib, st, blklastind, lda, tid, ldv; doublecomplex tmp; integer stt, inda; extern integer ilaenv2stage_(integer *, char *, char *, integer *, integer *, integer *, integer *); - integer thed, myid, indw, apos, dpos, indv, edind, debug; + integer thed, myid, indw, apos, dpos, indv, edind; extern logical lsame_(char *, char *); integer lhmin, sizea, shift, stind, colpt, lwmin, awpos; logical wantq, upper; - integer grsiz, sizev, ttype, abdpos; + integer grsiz, ttype, abdpos; extern /* Subroutine */ - int xerbla_(char *, integer *); + int + xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer thgrid, thgrnb, indtau; doublereal abstmp; integer ofdpos; extern /* Subroutine */ - int zhb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); + int + zhb2st_kernels_(char *, logical *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), + zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); +#ifdef FLA_OPENMP_MULTITHREADING + extern /* Function */ + int fla_thread_get_num_threads(); +#endif logical lquery, afters1; - extern /* Subroutine */ - int f90_exit_(void); integer ceiltmp, sweepid, nbtiles, sizetau, thgrsiz; - /* #if defined(_OPENMP) */ - /* use omp_lib */ - /* #endif */ + int nthreads; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -295,7 +299,6 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, --hous; --work; /* Function Body */ - debug = 0; *info = 0; afters1 = lsame_(stage1, "Y"); wantq = lsame_(vect, "V"); @@ -305,15 +308,15 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ib = ilaenv2stage_(&c__2, "ZHETRD_HB2ST", vect, n, kd, &c_n1, &c_n1); lhmin = ilaenv2stage_(&c__3, "ZHETRD_HB2ST", vect, n, kd, &ib, &c_n1); lwmin = ilaenv2stage_(&c__4, "ZHETRD_HB2ST", vect, n, kd, &ib, &c_n1); - if (! afters1 && ! lsame_(stage1, "N")) + if (!afters1 && !lsame_(stage1, "N")) { *info = -1; } - else if (! lsame_(vect, "N")) + else if (!lsame_(vect, "N")) { *info = -2; } - else if (! upper && ! lsame_(uplo, "L")) + else if (!upper && !lsame_(uplo, "L")) { *info = -3; } @@ -329,31 +332,31 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { *info = -7; } - else if (*lhous < lhmin && ! lquery) + else if (*lhous < lhmin && !lquery) { *info = -11; } - else if (*lwork < lwmin && ! lquery) + else if (*lwork < lwmin && !lquery) { *info = -13; } if (*info == 0) { - hous[1].r = (doublereal) lhmin; + hous[1].r = (doublereal)lhmin; hous[1].i = 0.; // , expr subst - work[1].r = (doublereal) lwmin; + work[1].r = (doublereal)lwmin; work[1].i = 0.; // , expr subst } if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD_HB2ST", &i__1); - AOCL_DTL_TRACE_LOG_EXIT + xerbla_("ZHETRD_HB2ST", &i__1, (ftnlen)12); + AOCL_DTL_TRACE_LOG_EXIT return 0; } else if (lquery) { - AOCL_DTL_TRACE_LOG_EXIT + AOCL_DTL_TRACE_LOG_EXIT return 0; } /* Quick return if possible */ @@ -363,20 +366,18 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, hous[1].i = 0.; // , expr subst work[1].r = 1.; work[1].i = 0.; // , expr subst - AOCL_DTL_TRACE_LOG_EXIT + AOCL_DTL_TRACE_LOG_EXIT return 0; } /* Determine pointer position */ ldv = *kd + ib; sizetau = *n << 1; - sizev = *n << 1; indtau = 1; indv = indtau + sizetau; lda = (*kd << 1) + 1; sizea = lda * *n; inda = 1; indw = inda + sizea; - nthreads = 1; tid = 0; if (upper) { @@ -405,8 +406,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abdpos + i__ * ab_dim1; d__[i__] = ab[i__2].r; @@ -414,8 +415,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, } i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { e[i__] = 0.; /* L40: */ @@ -424,7 +425,7 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, hous[1].i = 0.; // , expr subst work[1].r = 1.; work[1].i = 0.; // , expr subst - AOCL_DTL_TRACE_LOG_EXIT + AOCL_DTL_TRACE_LOG_EXIT return 0; } /* Case KD=1: */ @@ -440,8 +441,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abdpos + i__ * ab_dim1; d__[i__] = ab[i__2].r; @@ -452,8 +453,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abofdpos + (i__ + 1) * ab_dim1; tmp.r = ab[i__2].r; @@ -494,8 +495,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = abofdpos + i__ * ab_dim1; tmp.r = ab[i__2].r; @@ -536,7 +537,7 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, hous[1].i = 0.; // , expr subst work[1].r = 1.; work[1].i = 0.; // , expr subst - AOCL_DTL_TRACE_LOG_EXIT + AOCL_DTL_TRACE_LOG_EXIT return 0; } /* Main code start here. */ @@ -566,137 +567,137 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, ++thgrnb; } i__1 = *kd + 1; - zlacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda) ; + zlacpy_("A", &i__1, n, &ab[ab_offset], ldab, &work[apos], &lda); zlaset_("A", kd, n, &c_b1, &c_b1, &work[awpos], &lda); + /* openMP parallelisation start here */ - /* #if defined(_OPENMP) */ - /* !$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND ) */ - /* !$OMP$ PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) */ - /* !$OMP$ PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND ) */ - /* !$OMP$ SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK) */ - /* !$OMP$ SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA ) */ - /* !$OMP$ SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT ) */ - /* !$OMP MASTER */ - /* #endif */ - /* main bulge chasing loop */ - i__1 = thgrnb; - for (thgrid = 1; - thgrid <= i__1; - ++thgrid) + nthreads = 1; +#ifdef FLA_OPENMP_MULTITHREADING + nthreads = fla_thread_get_num_threads(); +#pragma omp parallel num_threads(nthreads) private(tid, thgrid, blklastind) \ + private(thed, i__, m, k, st, ed, stt, sweepid, myid, ttype, colpt, stind, edind) \ + shared(uplo, wantq, indv, indtau, hous, work, \ + n, kd, ib, nbtiles, lda, ldv, inda, stepercol, thgrnb, thgrsiz, grsiz, shift) { - stt = (thgrid - 1) * thgrsiz + 1; - /* Computing MIN */ - i__2 = stt + thgrsiz - 1; - i__3 = *n - 1; // , expr subst - thed = fla_min(i__2,i__3); - i__2 = *n - 1; - for (i__ = stt; - i__ <= i__2; - ++i__) +#pragma omp master { - ed = fla_min(i__,thed); - if (stt > ed) +#endif + /* main bulge chasing loop */ + i__1 = thgrnb; + for (thgrid = 1; + thgrid <= i__1; + ++thgrid) { - break; - } - i__3 = stepercol; - for (m = 1; - m <= i__3; - ++m) - { - st = stt; - i__4 = ed; - for (sweepid = st; - sweepid <= i__4; - ++sweepid) + stt = (thgrid - 1) * thgrsiz + 1; + /* Computing MIN */ + i__2 = stt + thgrsiz - 1; + i__3 = *n - 1; // , expr subst + thed = fla_min(i__2, i__3); + i__2 = *n - 1; + for (i__ = stt; + i__ <= i__2; + ++i__) { - i__5 = grsiz; - for (k = 1; - k <= i__5; - ++k) + ed = fla_min(i__, thed); + if (stt > ed) { - myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; - if (myid == 1) - { - ttype = 1; - } - else - { - ttype = myid % 2 + 2; - } - if (ttype == 2) - { - colpt = myid / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - blklastind = colpt; - } - else + break; + } + i__3 = stepercol; + for (m = 1; + m <= i__3; + ++m) + { + st = stt; + i__4 = ed; + for (sweepid = st; + sweepid <= i__4; + ++sweepid) { - colpt = (myid + 1) / 2 * *kd + sweepid; - stind = colpt - *kd + 1; - edind = fla_min(colpt,*n); - if (stind >= edind - 1 && edind == *n) + i__5 = grsiz; + for (k = 1; + k <= i__5; + ++k) { - blklastind = *n; + myid = (i__ - sweepid) * (stepercol * grsiz) + (m - 1) * grsiz + k; + if (myid == 1) + { + ttype = 1; + } + else + { + ttype = myid % 2 + 2; + } + if (ttype == 2) + { + colpt = myid / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + blklastind = colpt; + } + else + { + colpt = (myid + 1) / 2 * *kd + sweepid; + stind = colpt - *kd + 1; + edind = fla_min(colpt, *n); + if (stind >= edind - 1 && edind == *n) + { + blklastind = *n; + } + else + { + blklastind = 0; + } + } + /* Call the kernel */ +#ifdef FLA_OPENMP_MULTITHREADING + if (ttype != 1) + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(in : work[myid - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + zhb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } + else + { +#pragma omp task depend(in : work[myid + shift - 1]) \ + depend(out : work[myid]) + { + tid = omp_get_thread_num(); + zhb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); + } + } +#else + zhb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, &hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); +#endif + if (blklastind >= *n - 1) + { + ++stt; + break; + } + /* L140: */ } - else - { - blklastind = 0; - } - } - /* Call the kernel */ - /* #if defined(_OPENMP) */ - /* IF( TTYPE.NE.1 ) THEN */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(in:WORK(MYID-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ELSE */ - /* !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) */ - /* !$OMP$ DEPEND(out:WORK(MYID)) */ - /* TID = OMP_GET_THREAD_NUM() */ - /* CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, */ - /* $ STIND, EDIND, SWEEPID, N, KD, IB, */ - /* $ WORK ( INDA ), LDA, */ - /* $ HOUS( INDV ), HOUS( INDTAU ), LDV, */ - /* $ WORK( INDW + TID*KD ) ) */ - /* !$OMP END TASK */ - /* ENDIF */ - /* #else */ - zhb2st_kernels_(uplo, &wantq, &ttype, &stind, &edind, &sweepid, n, kd, &ib, &work[inda], &lda, & hous[indv], &hous[indtau], &ldv, &work[indw + tid * *kd]); - /* #endif */ - if (blklastind >= *n - 1) - { - ++stt; - break; + /* L130: */ } - /* L140: */ + /* L120: */ } - /* L130: */ + /* L110: */ } - /* L120: */ + /* L100: */ } - /* L110: */ - } - /* L100: */ - } - /* #if defined(_OPENMP) */ - /* !$OMP END MASTER */ - /* !$OMP END PARALLEL */ - /* #endif */ +#ifdef FLA_OPENMP_MULTITHREADING + } /* End OMP Master */ + } /* End OMP Parallel */ +#endif /* Copy the diagonal from A to D. Note that D is REAL thus only */ /* the Real part is needed, the imaginary part should be zero. */ i__1 = *n; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = dpos + (i__ - 1) * lda; d__[i__] = work[i__2].r; @@ -708,8 +709,8 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = ofdpos + i__ * lda; e[i__] = work[i__2].r; @@ -720,17 +721,17 @@ int zhetrd_hb2st_(char *stage1, char *vect, char *uplo, integer *n, integer *kd, { i__1 = *n - 1; for (i__ = 1; - i__ <= i__1; - ++i__) + i__ <= i__1; + ++i__) { i__2 = ofdpos + (i__ - 1) * lda; e[i__] = work[i__2].r; /* L170: */ } } - hous[1].r = (doublereal) lhmin; + hous[1].r = (doublereal)lhmin; hous[1].i = 0.; // , expr subst - work[1].r = (doublereal) lwmin; + work[1].r = (doublereal)lwmin; work[1].i = 0.; // , expr subst AOCL_DTL_TRACE_LOG_EXIT return 0; diff --git a/src/map/lapack2flamec/f2c/c/zhetrd_he2hb.c b/src/map/lapack2flamec/f2c/c/zhetrd_he2hb.c index 0694c31b1..9c23bcf0a 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrd_he2hb.c +++ b/src/map/lapack2flamec/f2c/c/zhetrd_he2hb.c @@ -265,7 +265,7 @@ int zhetrd_he2hb_(char *uplo, integer *n, integer *kd, doublecomplex *a, integer integer lwmin; logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(char *, integer *), zgelqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zgeqrf_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zlarft_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgelqf_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zgeqrf_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, integer *), zlarft_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -336,7 +336,7 @@ int zhetrd_he2hb_(char *uplo, integer *n, integer *kd, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD_HE2HB", &i__1); + xerbla_("ZHETRD_HE2HB", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrf.c b/src/map/lapack2flamec/f2c/c/zhetrf.c index c393d8b80..8cf6f5d47 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrf.c +++ b/src/map/lapack2flamec/f2c/c/zhetrf.c @@ -180,7 +180,7 @@ int zhetrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zhetf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *), zlahef_(char *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), xerbla_(char *, integer *); + int zhetf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *), zlahef_(char *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -240,7 +240,7 @@ int zhetrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRF", &i__1); + xerbla_("ZHETRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrf_aa.c b/src/map/lapack2flamec/f2c/c/zhetrf_aa.c index 7dcd55264..c56ac00c7 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/zhetrf_aa.c @@ -150,7 +150,7 @@ int zhetrf_aa_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer * int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -217,7 +217,7 @@ int zhetrf_aa_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRF_AA", &i__1); + xerbla_("ZHETRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zhetrf_aa_2stage.c index b56cd6af4..7ea7fed42 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhetrf_aa_2stage.c @@ -187,7 +187,7 @@ int zhetrf_aa_2stage_(char *uplo, integer *n, doublecomplex *a, integer *lda, do int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlacgv_(integer *, doublecomplex *, integer *), zgbtrf_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgetrf_( integer *, integer *, doublecomplex *, integer *, integer *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), zhegst_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -248,7 +248,7 @@ int zhetrf_aa_2stage_(char *uplo, integer *n, doublecomplex *a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRF_AA_2STAGE", &i__1); + xerbla_("ZHETRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrf_rk.c b/src/map/lapack2flamec/f2c/c/zhetrf_rk.c index 0afe0bc89..89d5c6729 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/zhetrf_rk.c @@ -265,7 +265,7 @@ int zhetrf_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -326,7 +326,7 @@ int zhetrf_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRF_RK", &i__1); + xerbla_("ZHETRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrf_rook.c b/src/map/lapack2flamec/f2c/c/zhetrf_rook.c index e4b114c13..529dec4a2 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhetrf_rook.c @@ -219,7 +219,7 @@ int zhetrf_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -282,7 +282,7 @@ int zhetrf_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRF_ROOK", &i__1); + xerbla_("ZHETRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri.c b/src/map/lapack2flamec/f2c/c/zhetri.c index 0576a73ae..b8453fdd0 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri.c +++ b/src/map/lapack2flamec/f2c/c/zhetri.c @@ -137,7 +137,7 @@ int zhetri_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi int zhemv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -183,7 +183,7 @@ int zhetri_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI", &i__1); + xerbla_("ZHETRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri2.c b/src/map/lapack2flamec/f2c/c/zhetri2.c index 39422c5d3..2885547af 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri2.c +++ b/src/map/lapack2flamec/f2c/c/zhetri2.c @@ -134,7 +134,7 @@ int zhetri2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ip integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zhetri_(char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); @@ -197,7 +197,7 @@ int zhetri2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ip if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI2", &i__1); + xerbla_("ZHETRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri2x.c b/src/map/lapack2flamec/f2c/c/zhetri2x.c index 4b5fa4592..e79d30176 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri2x.c +++ b/src/map/lapack2flamec/f2c/c/zhetri2x.c @@ -152,7 +152,7 @@ int zhetri2x_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *i int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); doublecomplex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), ztrtri_( char *, char *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ztrtri_( char *, char *, integer *, doublecomplex *, integer *, integer *); doublecomplex u01_ip1_j__, u11_ip1_j__; extern /* Subroutine */ int zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); @@ -204,7 +204,7 @@ int zhetri2x_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI2X", &i__1); + xerbla_("ZHETRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri_3.c b/src/map/lapack2flamec/f2c/c/zhetri_3.c index a55d289e9..101710976 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri_3.c +++ b/src/map/lapack2flamec/f2c/c/zhetri_3.c @@ -176,7 +176,7 @@ int zhetri_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -235,7 +235,7 @@ int zhetri_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI_3", &i__1); + xerbla_("ZHETRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri_3x.c b/src/map/lapack2flamec/f2c/c/zhetri_3x.c index 85b1010c4..dc26be264 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri_3x.c +++ b/src/map/lapack2flamec/f2c/c/zhetri_3x.c @@ -189,7 +189,7 @@ int zhetri_3x_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); doublecomplex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int ztrtri_(char *, char *, integer *, doublecomplex *, integer *, integer *); @@ -243,7 +243,7 @@ int zhetri_3x_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI_3X", &i__1); + xerbla_("ZHETRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetri_rook.c b/src/map/lapack2flamec/f2c/c/zhetri_rook.c index c5e947764..876bc04e1 100644 --- a/src/map/lapack2flamec/f2c/c/zhetri_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhetri_rook.c @@ -149,7 +149,7 @@ int zhetri_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer int zhemv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -195,7 +195,7 @@ int zhetri_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRI_ROOK", &i__1); + xerbla_("ZHETRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs.c b/src/map/lapack2flamec/f2c/c/zhetrs.c index fb49e76bc..10c77459b 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs.c @@ -135,7 +135,7 @@ int zhetrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -190,7 +190,7 @@ int zhetrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS", &i__1); + xerbla_("ZHETRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs2.c b/src/map/lapack2flamec/f2c/c/zhetrs2.c index 1f72573fc..be57051eb 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs2.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs2.c @@ -140,7 +140,7 @@ int zhetrs2_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *l integer iinfo; logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -196,7 +196,7 @@ int zhetrs2_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS2", &i__1); + xerbla_("ZHETRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs_3.c b/src/map/lapack2flamec/f2c/c/zhetrs_3.c index 3d756c136..cda549e72 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs_3.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs_3.c @@ -177,7 +177,7 @@ int zhetrs_3_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * doublecomplex denom; logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -233,7 +233,7 @@ int zhetrs_3_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS_3", &i__1); + xerbla_("ZHETRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs_aa.c b/src/map/lapack2flamec/f2c/c/zhetrs_aa.c index aefc3307c..67d334a05 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs_aa.c @@ -135,7 +135,7 @@ int zhetrs_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgtsv_(integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgtsv_(integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -203,7 +203,7 @@ int zhetrs_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS_AA", &i__1); + xerbla_("ZHETRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zhetrs_aa_2stage.c index 069d0ad59..9454afd5c 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs_aa_2stage.c @@ -146,7 +146,7 @@ int zhetrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, i extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -206,7 +206,7 @@ int zhetrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS_AA_2STAGE", &i__1); + xerbla_("ZHETRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhetrs_rook.c b/src/map/lapack2flamec/f2c/c/zhetrs_rook.c index 2d0e1396a..58787a4ea 100644 --- a/src/map/lapack2flamec/f2c/c/zhetrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/zhetrs_rook.c @@ -149,7 +149,7 @@ int zhetrs_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, intege int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -204,7 +204,7 @@ int zhetrs_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRS_ROOK", &i__1); + xerbla_("ZHETRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhfrk.c b/src/map/lapack2flamec/f2c/c/zhfrk.c index 4e9727f8a..23cbe1d42 100644 --- a/src/map/lapack2flamec/f2c/c/zhfrk.c +++ b/src/map/lapack2flamec/f2c/c/zhfrk.c @@ -172,7 +172,7 @@ int zhfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, double logical lower; doublecomplex calpha; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int zhfrk_(char *transr, char *uplo, char *trans, integer *n, integer *k, double if (info != 0) { i__1 = -info; - xerbla_("ZHFRK ", &i__1); + xerbla_("ZHFRK ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhgeqz.c b/src/map/lapack2flamec/f2c/c/zhgeqz.c index 57bf415cc..73e5f28a9 100644 --- a/src/map/lapack2flamec/f2c/c/zhgeqz.c +++ b/src/map/lapack2flamec/f2c/c/zhgeqz.c @@ -1,7 +1,7 @@ /* zhgeqz.f -- translated by f2c (version 20160102). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ /* - * Copyright (c) 2020-2023 Advanced Micro Devices, Inc.  All rights reserved. + * Copyright (c) 2020-2023 Advanced Micro Devices, Inc. All rights reserved. */ #include "FLA_f2c.h" /* Table of constant values */ #ifdef FLA_OPENMP_MULTITHREADING @@ -324,6 +324,10 @@ int fla_zhgeqz(char *job, char *compq, char *compz, integer *n, integer *ilo, in doublereal d_imag(doublecomplex *); void z_div(doublecomplex *, doublecomplex *, doublecomplex *), z_sqrt( doublecomplex *, doublecomplex *), pow_zi(doublecomplex *, doublecomplex *, integer *); /* Local variables */ +#ifdef FLA_OPENMP_MULTITHREADING + extern /* Function */ + int fla_thread_get_num_threads(); +#endif doublereal c__; integer j; doublecomplex s, x, y; @@ -359,7 +363,7 @@ int fla_zhgeqz(char *job, char *compq, char *compz, integer *n, integer *ilo, in doublecomplex signbc; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublecomplex eshift; logical ilschr; integer icompq, ilastm; @@ -376,18 +380,12 @@ int fla_zhgeqz(char *job, char *compq, char *compz, integer *n, integer *ilo, in int zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); integer istart; logical lquery; + int num_threads, tid; /* Initialize global context data */ aocl_fla_init(); #ifdef FLA_ENABLE_AMD_OPT -#ifdef FLA_OPENMP_MULTITHREADING - int num_threads = omp_get_max_threads(); - int tid; -#else - int num_threads = 1; - int tid = 0; -#endif doublereal c1; doublecomplex s1; integer max_swps = QZ_MAX_SWEEPS; @@ -575,7 +573,7 @@ int fla_zhgeqz(char *job, char *compq, char *compz, integer *n, integer *ilo, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZHGEQZ", &i__1); + xerbla_("ZHGEQZ", &i__1, (ftnlen)6); return 0; } else if (lquery) @@ -1425,12 +1423,17 @@ int fla_zhgeqz(char *job, char *compq, char *compz, integer *n, integer *ilo, in num_swps++; } + #ifdef FLA_OPENMP_MULTITHREADING + num_threads = fla_thread_get_num_threads(); + num_threads = fla_min(2, num_threads); #pragma omp parallel num_threads(num_threads) private(j, i__3, i__4, i__5, tid) { tid = omp_get_thread_num(); #else + num_threads = 1; + tid = 0; { #endif for (j = istart; diff --git a/src/map/lapack2flamec/f2c/c/zhpcon.c b/src/map/lapack2flamec/f2c/c/zhpcon.c index 9c77d1ca5..773dc52c6 100644 --- a/src/map/lapack2flamec/f2c/c/zhpcon.c +++ b/src/map/lapack2flamec/f2c/c/zhpcon.c @@ -119,7 +119,7 @@ int zhpcon_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublereal integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zhptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -166,7 +166,7 @@ int zhpcon_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPCON", &i__1); + xerbla_("ZHPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpev.c b/src/map/lapack2flamec/f2c/c/zhpev.c index 734e4760c..5c04478e8 100644 --- a/src/map/lapack2flamec/f2c/c/zhpev.c +++ b/src/map/lapack2flamec/f2c/c/zhpev.c @@ -154,7 +154,7 @@ int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex *ap, doublereal *w, integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -215,7 +215,7 @@ int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex *ap, doublereal *w, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPEV ", &i__1); + xerbla_("ZHPEV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpevd.c b/src/map/lapack2flamec/f2c/c/zhpevd.c index c67fff6d8..1c3de0915 100644 --- a/src/map/lapack2flamec/f2c/c/zhpevd.c +++ b/src/map/lapack2flamec/f2c/c/zhpevd.c @@ -220,7 +220,7 @@ int zhpevd_(char *jobz, char *uplo, integer *n, doublecomplex *ap, doublereal *w integer iscale; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; integer indtau; extern /* Subroutine */ @@ -330,7 +330,7 @@ int zhpevd_(char *jobz, char *uplo, integer *n, doublecomplex *ap, doublereal *w if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPEVD", &i__1); + xerbla_("ZHPEVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpevx.c b/src/map/lapack2flamec/f2c/c/zhpevx.c index 02aa063e0..48585244c 100644 --- a/src/map/lapack2flamec/f2c/c/zhpevx.c +++ b/src/map/lapack2flamec/f2c/c/zhpevx.c @@ -261,7 +261,7 @@ int zhpevx_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *ap, logical valeig; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal abstll, bignum; integer indiwk, indisp, indtau; extern /* Subroutine */ @@ -355,7 +355,7 @@ int zhpevx_(char *jobz, char *range, char *uplo, integer *n, doublecomplex *ap, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPEVX", &i__1); + xerbla_("ZHPEVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpgst.c b/src/map/lapack2flamec/f2c/c/zhpgst.c index cc22f3511..97184f521 100644 --- a/src/map/lapack2flamec/f2c/c/zhpgst.c +++ b/src/map/lapack2flamec/f2c/c/zhpgst.c @@ -132,7 +132,7 @@ int zhpgst_(integer *itype, char *uplo, integer *n, doublecomplex *ap, doublecom VOID zdotc_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -175,7 +175,7 @@ int zhpgst_(integer *itype, char *uplo, integer *n, doublecomplex *ap, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPGST", &i__1); + xerbla_("ZHPGST", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpgv.c b/src/map/lapack2flamec/f2c/c/zhpgv.c index a1e2fa83a..b8c9ee22b 100644 --- a/src/map/lapack2flamec/f2c/c/zhpgv.c +++ b/src/map/lapack2flamec/f2c/c/zhpgv.c @@ -174,7 +174,7 @@ int zhpgv_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex *a int zhpev_(char *, char *, integer *, doublecomplex *, doublereal *, doublecomplex *, integer *, doublecomplex *, doublereal *, integer *); logical wantz; extern /* Subroutine */ - int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *), zhpgst_(integer *, char *, integer *, doublecomplex *, doublecomplex *, integer *), zpptrf_( char *, integer *, doublecomplex *, integer *); + int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zhpgst_(integer *, char *, integer *, doublecomplex *, doublecomplex *, integer *), zpptrf_( char *, integer *, doublecomplex *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -228,7 +228,7 @@ int zhpgv_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPGV ", &i__1); + xerbla_("ZHPGV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpgvd.c b/src/map/lapack2flamec/f2c/c/zhpgvd.c index beffe7c38..bf70c6f61 100644 --- a/src/map/lapack2flamec/f2c/c/zhpgvd.c +++ b/src/map/lapack2flamec/f2c/c/zhpgvd.c @@ -241,7 +241,7 @@ int zhpgvd_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex * char trans[1]; logical upper, wantz; extern /* Subroutine */ - int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer liwmin; extern /* Subroutine */ int zhpevd_(char *, char *, integer *, doublecomplex *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *); @@ -350,7 +350,7 @@ int zhpgvd_(integer *itype, char *jobz, char *uplo, integer * n, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPGVD", &i__1); + xerbla_("ZHPGVD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpgvx.c b/src/map/lapack2flamec/f2c/c/zhpgvx.c index 9d7eca07a..95df349bd 100644 --- a/src/map/lapack2flamec/f2c/c/zhpgvx.c +++ b/src/map/lapack2flamec/f2c/c/zhpgvx.c @@ -288,7 +288,7 @@ int zhpgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *); logical alleig, indeig, valeig; extern /* Subroutine */ - int xerbla_(char *, integer *), zhpgst_( integer *, char *, integer *, doublecomplex *, doublecomplex *, integer *), zhpevx_(char *, char *, char *, integer *, doublecomplex *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublecomplex *, integer *, doublecomplex *, doublereal *, integer *, integer *, integer *), zpptrf_(char *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zhpgst_( integer *, char *, integer *, doublecomplex *, doublecomplex *, integer *), zhpevx_(char *, char *, char *, integer *, doublecomplex *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublecomplex *, integer *, doublecomplex *, doublereal *, integer *, integer *, integer *), zpptrf_(char *, integer *, doublecomplex *, integer *); /* -- LAPACK driver routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -377,7 +377,7 @@ int zhpgvx_(integer *itype, char *jobz, char *range, char * uplo, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPGVX", &i__1); + xerbla_("ZHPGVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhprfs.c b/src/map/lapack2flamec/f2c/c/zhprfs.c index 7807f9aa7..5dc452a42 100644 --- a/src/map/lapack2flamec/f2c/c/zhprfs.c +++ b/src/map/lapack2flamec/f2c/c/zhprfs.c @@ -200,7 +200,7 @@ int zhprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zhptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -271,7 +271,7 @@ int zhprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPRFS", &i__1); + xerbla_("ZHPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpsv.c b/src/map/lapack2flamec/f2c/c/zhpsv.c index e82d9836f..97aadc375 100644 --- a/src/map/lapack2flamec/f2c/c/zhpsv.c +++ b/src/map/lapack2flamec/f2c/c/zhpsv.c @@ -159,7 +159,7 @@ int zhpsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *ip /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zhptrf_( char *, integer *, doublecomplex *, integer *, integer *), zhptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zhptrf_( char *, integer *, doublecomplex *, integer *, integer *), zhptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -204,7 +204,7 @@ int zhpsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *ip if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPSV ", &i__1); + xerbla_("ZHPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhpsvx.c b/src/map/lapack2flamec/f2c/c/zhpsvx.c index bc806b1d3..3538e8655 100644 --- a/src/map/lapack2flamec/f2c/c/zhpsvx.c +++ b/src/map/lapack2flamec/f2c/c/zhpsvx.c @@ -279,7 +279,7 @@ int zhpsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *, doublereal *); extern /* Subroutine */ int zhpcon_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zhprfs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zhptrf_(char *, integer *, doublecomplex *, integer *, integer *), zhptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -348,7 +348,7 @@ int zhpsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPSVX", &i__1); + xerbla_("ZHPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhptrd.c b/src/map/lapack2flamec/f2c/c/zhptrd.c index 1b2534e19..a41981044 100644 --- a/src/map/lapack2flamec/f2c/c/zhptrd.c +++ b/src/map/lapack2flamec/f2c/c/zhptrd.c @@ -168,7 +168,7 @@ int zhptrd_(char *uplo, integer *n, doublecomplex *ap, doublereal *d__, doublere VOID zdotc_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -209,7 +209,7 @@ int zhptrd_(char *uplo, integer *n, doublecomplex *ap, doublereal *d__, doublere if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPTRD", &i__1); + xerbla_("ZHPTRD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhptrf.c b/src/map/lapack2flamec/f2c/c/zhptrf.c index f5cb44f0f..f37b95a34 100644 --- a/src/map/lapack2flamec/f2c/c/zhptrf.c +++ b/src/map/lapack2flamec/f2c/c/zhptrf.c @@ -184,7 +184,7 @@ int zhptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i extern doublereal dlapy2_(doublereal *, doublereal *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -219,6 +219,8 @@ int zhptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; + jmax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -230,7 +232,7 @@ int zhptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPTRF", &i__1); + xerbla_("ZHPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhptri.c b/src/map/lapack2flamec/f2c/c/zhptri.c index d748eb379..e5b67cda3 100644 --- a/src/map/lapack2flamec/f2c/c/zhptri.c +++ b/src/map/lapack2flamec/f2c/c/zhptri.c @@ -130,7 +130,7 @@ int zhptri_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublecomp integer kstep; logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zswap_( integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zhpmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zswap_( integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -171,7 +171,7 @@ int zhptri_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPTRI", &i__1); + xerbla_("ZHPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhptrs.c b/src/map/lapack2flamec/f2c/c/zhptrs.c index 1753dba5b..100af990a 100644 --- a/src/map/lapack2flamec/f2c/c/zhptrs.c +++ b/src/map/lapack2flamec/f2c/c/zhptrs.c @@ -130,7 +130,7 @@ int zhptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *i int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -179,7 +179,7 @@ int zhptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZHPTRS", &i__1); + xerbla_("ZHPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhsein.c b/src/map/lapack2flamec/f2c/c/zhsein.c index c046c1b5b..9218ccab1 100644 --- a/src/map/lapack2flamec/f2c/c/zhsein.c +++ b/src/map/lapack2flamec/f2c/c/zhsein.c @@ -266,7 +266,7 @@ int zhsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, extern doublereal dlamch_(char *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlaein_( logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaein_( logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, integer *); extern doublereal zlanhs_(char *, integer *, doublecomplex *, integer *, doublereal *); logical noinit; integer ldwork; @@ -369,7 +369,7 @@ int zhsein_(char *side, char *eigsrc, char *initv, logical * select, integer *n, if (*info != 0) { i__1 = -(*info); - xerbla_("ZHSEIN", &i__1); + xerbla_("ZHSEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zhseqr.c b/src/map/lapack2flamec/f2c/c/zhseqr.c index b2c8352ed..e60cc54cc 100644 --- a/src/map/lapack2flamec/f2c/c/zhseqr.c +++ b/src/map/lapack2flamec/f2c/c/zhseqr.c @@ -13,7 +13,6 @@ static doublecomplex c_b2 = ; static integer c__1 = 1; static integer c__12 = 12; -static integer c__2 = 2; static integer c__49 = 49; /* > \brief \b ZHSEQR */ /* =========== DOCUMENTATION =========== */ @@ -303,8 +302,7 @@ int zhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zhseqr inputs: job %c, compz %c, n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", ldh %" FLA_IS ", ldz %" FLA_IS ", lwork %" FLA_IS "",*job, *compz, *n, *ilo, *ihi, *ldh, *ldz, *lwork); /* System generated locals */ - address a__1[2]; - integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2]; + integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2; doublereal d__1, d__2, d__3; doublecomplex z__1; char ch__1[2]; @@ -320,7 +318,7 @@ int zhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub doublecomplex workl[49]; logical wantt, wantz; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaqr0_(logical *, logical *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), xerbla_(char *, integer * ); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaqr0_(logical *, logical *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlahqr_(logical *, logical *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); @@ -412,7 +410,7 @@ int zhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doub { /* ==== Quick return in case of invalid argument. ==== */ i__1 = -(*info); - xerbla_("ZHSEQR", &i__1); + xerbla_("ZHSEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_gbamv.c b/src/map/lapack2flamec/f2c/c/zla_gbamv.c index 536b01ecd..fbc5a2827 100644 --- a/src/map/lapack2flamec/f2c/c/zla_gbamv.c +++ b/src/map/lapack2flamec/f2c/c/zla_gbamv.c @@ -190,7 +190,7 @@ int zla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, doublereal safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -258,7 +258,7 @@ int zla_gbamv_(integer *trans, integer *m, integer *n, integer *kl, integer *ku, } if (info != 0) { - xerbla_("ZLA_GBAMV ", &info); + xerbla_("ZLA_GBAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_gbrcond_c.c b/src/map/lapack2flamec/f2c/c/zla_gbrcond_c.c index c844db38a..6a30f1e35 100644 --- a/src/map/lapack2flamec/f2c/c/zla_gbrcond_c.c +++ b/src/map/lapack2flamec/f2c/c/zla_gbrcond_c.c @@ -165,7 +165,7 @@ doublereal zla_gbrcond_c_(char *trans, integer *n, integer *kl, integer *ku, dou integer isave[3]; doublereal anorm; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -235,7 +235,7 @@ doublereal zla_gbrcond_c_(char *trans, integer *n, integer *kl, integer *ku, dou if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_GBRCOND_C", &i__1); + xerbla_("ZLA_GBRCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_gbrcond_x.c b/src/map/lapack2flamec/f2c/c/zla_gbrcond_x.c index 3d79ff242..326b7aea8 100644 --- a/src/map/lapack2flamec/f2c/c/zla_gbrcond_x.c +++ b/src/map/lapack2flamec/f2c/c/zla_gbrcond_x.c @@ -159,7 +159,7 @@ doublereal zla_gbrcond_x_(char *trans, integer *n, integer *kl, integer *ku, dou integer isave[3]; doublereal anorm; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -229,7 +229,7 @@ doublereal zla_gbrcond_x_(char *trans, integer *n, integer *kl, integer *ku, dou if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_GBRCOND_X", &i__1); + xerbla_("ZLA_GBRCOND_X", &i__1, (ftnlen)13); return ret_val; } /* Compute norm of op(A)*op2(C). */ diff --git a/src/map/lapack2flamec/f2c/c/zla_geamv.c b/src/map/lapack2flamec/f2c/c/zla_geamv.c index 7991e97d5..2182bd649 100644 --- a/src/map/lapack2flamec/f2c/c/zla_geamv.c +++ b/src/map/lapack2flamec/f2c/c/zla_geamv.c @@ -179,7 +179,7 @@ int zla_geamv_(integer *trans, integer *m, integer *n, doublereal *alpha, double doublereal safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -239,7 +239,7 @@ int zla_geamv_(integer *trans, integer *m, integer *n, doublereal *alpha, double } if (info != 0) { - xerbla_("ZLA_GEAMV ", &info); + xerbla_("ZLA_GEAMV ", &info, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_gercond_c.c b/src/map/lapack2flamec/f2c/c/zla_gercond_c.c index 9f53dcf63..2a6161156 100644 --- a/src/map/lapack2flamec/f2c/c/zla_gercond_c.c +++ b/src/map/lapack2flamec/f2c/c/zla_gercond_c.c @@ -147,7 +147,7 @@ doublereal zla_gercond_c_(char *trans, integer *n, doublecomplex *a, integer *ld integer isave[3]; doublereal anorm; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zgetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -210,7 +210,7 @@ doublereal zla_gercond_c_(char *trans, integer *n, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_GERCOND_C", &i__1); + xerbla_("ZLA_GERCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_gercond_x.c b/src/map/lapack2flamec/f2c/c/zla_gercond_x.c index 5fa232248..11fe4003e 100644 --- a/src/map/lapack2flamec/f2c/c/zla_gercond_x.c +++ b/src/map/lapack2flamec/f2c/c/zla_gercond_x.c @@ -141,7 +141,7 @@ doublereal zla_gercond_x_(char *trans, integer *n, doublecomplex *a, integer *ld integer isave[3]; doublereal anorm; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zgetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -204,7 +204,7 @@ doublereal zla_gercond_x_(char *trans, integer *n, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_GERCOND_X", &i__1); + xerbla_("ZLA_GERCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_heamv.c b/src/map/lapack2flamec/f2c/c/zla_heamv.c index 840211558..f0e690d65 100644 --- a/src/map/lapack2flamec/f2c/c/zla_heamv.c +++ b/src/map/lapack2flamec/f2c/c/zla_heamv.c @@ -179,7 +179,7 @@ int zla_heamv_(integer *uplo, integer *n, doublereal *alpha, doublecomplex *a, i doublereal temp, safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -236,7 +236,7 @@ int zla_heamv_(integer *uplo, integer *n, doublereal *alpha, doublecomplex *a, i } if (info != 0) { - xerbla_("ZHEMV ", &info); + xerbla_("ZHEMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_hercond_c.c b/src/map/lapack2flamec/f2c/c/zla_hercond_c.c index 5d6f17ee6..6b1f7c9c4 100644 --- a/src/map/lapack2flamec/f2c/c/zla_hercond_c.c +++ b/src/map/lapack2flamec/f2c/c/zla_hercond_c.c @@ -146,7 +146,7 @@ doublereal zla_hercond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -208,7 +208,7 @@ doublereal zla_hercond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_HERCOND_C", &i__1); + xerbla_("ZLA_HERCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_hercond_x.c b/src/map/lapack2flamec/f2c/c/zla_hercond_x.c index 8878e80ff..974e66463 100644 --- a/src/map/lapack2flamec/f2c/c/zla_hercond_x.c +++ b/src/map/lapack2flamec/f2c/c/zla_hercond_x.c @@ -140,7 +140,7 @@ doublereal zla_hercond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -202,7 +202,7 @@ doublereal zla_hercond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_HERCOND_X", &i__1); + xerbla_("ZLA_HERCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_herfsx_extended.c b/src/map/lapack2flamec/f2c/c/zla_herfsx_extended.c index b902e7001..50bc34875 100644 --- a/src/map/lapack2flamec/f2c/c/zla_herfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/zla_herfsx_extended.c @@ -438,7 +438,7 @@ AOCL_DTL_SNPRINTF("zla_herfsx_extended inputs: prec_type__ %" FLA_IS ", uplo %c, int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal normdx; extern /* Subroutine */ int zhetrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -529,7 +529,7 @@ AOCL_DTL_SNPRINTF("zla_herfsx_extended inputs: prec_type__ %" FLA_IS ", uplo %c, if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_HERFSX_EXTENDED", &i__1); + xerbla_("ZLA_HERFSX_EXTENDED", &i__1, (ftnlen)19); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_porcond_c.c b/src/map/lapack2flamec/f2c/c/zla_porcond_c.c index d704eba07..4141da17f 100644 --- a/src/map/lapack2flamec/f2c/c/zla_porcond_c.c +++ b/src/map/lapack2flamec/f2c/c/zla_porcond_c.c @@ -138,7 +138,7 @@ doublereal zla_porcond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -199,7 +199,7 @@ doublereal zla_porcond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_PORCOND_C", &i__1); + xerbla_("ZLA_PORCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_porcond_x.c b/src/map/lapack2flamec/f2c/c/zla_porcond_x.c index 7dca39a14..b4ec82852 100644 --- a/src/map/lapack2flamec/f2c/c/zla_porcond_x.c +++ b/src/map/lapack2flamec/f2c/c/zla_porcond_x.c @@ -132,7 +132,7 @@ doublereal zla_porcond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -193,7 +193,7 @@ doublereal zla_porcond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_PORCOND_X", &i__1); + xerbla_("ZLA_PORCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_syamv.c b/src/map/lapack2flamec/f2c/c/zla_syamv.c index 358280115..acf091b79 100644 --- a/src/map/lapack2flamec/f2c/c/zla_syamv.c +++ b/src/map/lapack2flamec/f2c/c/zla_syamv.c @@ -180,7 +180,7 @@ int zla_syamv_(integer *uplo, integer *n, doublereal *alpha, doublecomplex *a, i doublereal temp, safe1; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilauplo_(char *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -237,7 +237,7 @@ int zla_syamv_(integer *uplo, integer *n, doublereal *alpha, doublecomplex *a, i } if (info != 0) { - xerbla_("ZLA_SYAMV", &info); + xerbla_("ZLA_SYAMV", &info, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zla_syrcond_c.c b/src/map/lapack2flamec/f2c/c/zla_syrcond_c.c index e97e9f199..a20f39d92 100644 --- a/src/map/lapack2flamec/f2c/c/zla_syrcond_c.c +++ b/src/map/lapack2flamec/f2c/c/zla_syrcond_c.c @@ -146,7 +146,7 @@ doublereal zla_syrcond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zsytrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -208,7 +208,7 @@ doublereal zla_syrcond_c_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_SYRCOND_C", &i__1); + xerbla_("ZLA_SYRCOND_C", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_syrcond_x.c b/src/map/lapack2flamec/f2c/c/zla_syrcond_x.c index fdba05c9c..c9f631cbd 100644 --- a/src/map/lapack2flamec/f2c/c/zla_syrcond_x.c +++ b/src/map/lapack2flamec/f2c/c/zla_syrcond_x.c @@ -140,7 +140,7 @@ doublereal zla_syrcond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld doublereal anorm; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zsytrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -202,7 +202,7 @@ doublereal zla_syrcond_x_(char *uplo, integer *n, doublecomplex *a, integer * ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_SYRCOND_X", &i__1); + xerbla_("ZLA_SYRCOND_X", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return ret_val; } diff --git a/src/map/lapack2flamec/f2c/c/zla_syrfsx_extended.c b/src/map/lapack2flamec/f2c/c/zla_syrfsx_extended.c index 4fdc6440a..f67cdc2af 100644 --- a/src/map/lapack2flamec/f2c/c/zla_syrfsx_extended.c +++ b/src/map/lapack2flamec/f2c/c/zla_syrfsx_extended.c @@ -436,7 +436,7 @@ int zla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zsymv_( char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal normdx; extern /* Subroutine */ int zsytrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -527,7 +527,7 @@ int zla_syrfsx_extended_(integer *prec_type__, char *uplo, integer *n, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZLA_HERFSX_EXTENDED", &i__1); + xerbla_("ZLA_HERFSX_EXTENDED", &i__1, (ftnlen)19); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlabrd.c b/src/map/lapack2flamec/f2c/c/zlabrd.c index e145cab49..00d0c9c8f 100644 --- a/src/map/lapack2flamec/f2c/c/zlabrd.c +++ b/src/map/lapack2flamec/f2c/c/zlabrd.c @@ -278,16 +278,17 @@ int fla_zlabrd(integer *m, integer *n, integer *nb, doublecomplex *a, integer *l y_offset = 1 + y_dim1; y -= y_offset; -#ifdef FLA_OPENMP_MULTITHREADING - /* Get optimum thread number for CLABRD*/ - FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); -#endif - /* Function Body */ if (*m <= 0 || *n <= 0) { return 0; } + +#ifdef FLA_OPENMP_MULTITHREADING + /* Get optimum thread number for CLABRD*/ + FLA_Thread_optimum( FLA_LABRD, &actual_num_threads); +#endif + if (*m >= *n) { /* Reduce to upper bidiagonal form */ diff --git a/src/map/lapack2flamec/f2c/c/zlaed0.c b/src/map/lapack2flamec/f2c/c/zlaed0.c index 5b90469ef..3c9d2b169 100644 --- a/src/map/lapack2flamec/f2c/c/zlaed0.c +++ b/src/map/lapack2flamec/f2c/c/zlaed0.c @@ -156,7 +156,7 @@ int zlaed0_(integer *qsiz, integer *n, doublereal *d__, doublereal *e, doublecom int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaed7_(integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublecomplex *, doublereal *, integer *, integer *) ; integer igivcl; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlacrm_(integer *, integer *, doublecomplex *, integer *, doublereal *, integer *, doublecomplex *, integer *, doublereal *); @@ -222,7 +222,7 @@ int zlaed0_(integer *qsiz, integer *n, doublereal *d__, doublereal *e, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAED0", &i__1); + xerbla_("ZLAED0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaed7.c b/src/map/lapack2flamec/f2c/c/zlaed7.c index b97d57252..44ba3bd0c 100644 --- a/src/map/lapack2flamec/f2c/c/zlaed7.c +++ b/src/map/lapack2flamec/f2c/c/zlaed7.c @@ -250,7 +250,7 @@ int zlaed7_(integer *n, integer *cutpnt, integer *qsiz, integer *tlvls, integer int dlaed9_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), zlaed8_(integer *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublereal *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *), dlaeda_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer idlmda; extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *), zlacrm_(integer *, integer *, doublecomplex *, integer *, doublereal *, integer *, doublecomplex *, integer *, doublereal * ); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacrm_(integer *, integer *, doublecomplex *, integer *, doublereal *, integer *, doublecomplex *, integer *, doublereal * ); integer coltyp; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -309,7 +309,7 @@ int zlaed7_(integer *n, integer *cutpnt, integer *qsiz, integer *tlvls, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAED7", &i__1); + xerbla_("ZLAED7", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaed8.c b/src/map/lapack2flamec/f2c/c/zlaed8.c index 80b1c2d27..c4d767f12 100644 --- a/src/map/lapack2flamec/f2c/c/zlaed8.c +++ b/src/map/lapack2flamec/f2c/c/zlaed8.c @@ -236,7 +236,7 @@ int zlaed8_(integer *k, integer *n, integer *qsiz, doublecomplex *q, integer *ld extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(char *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -277,6 +277,7 @@ int zlaed8_(integer *k, integer *n, integer *qsiz, doublecomplex *q, integer *ld givnum -= 3; /* Function Body */ *info = 0; + jlam = 0; if (*n < 0) { *info = -2; @@ -300,7 +301,7 @@ int zlaed8_(integer *k, integer *n, integer *qsiz, doublecomplex *q, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAED8", &i__1); + xerbla_("ZLAED8", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaein.c b/src/map/lapack2flamec/f2c/c/zlaein.c index 86a005d32..bd4aa1cb9 100644 --- a/src/map/lapack2flamec/f2c/c/zlaein.c +++ b/src/map/lapack2flamec/f2c/c/zlaein.c @@ -163,7 +163,7 @@ int zlaein_(logical *rightv, logical *noinit, integer *n, doublecomplex *h__, in int zdscal_(integer *, doublereal *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); char normin[1]; extern doublereal dzasum_(integer *, doublecomplex *, integer *); doublereal nrmsml; diff --git a/src/map/lapack2flamec/f2c/c/zlahef.c b/src/map/lapack2flamec/f2c/c/zlahef.c index 02b3fb917..616957127 100644 --- a/src/map/lapack2flamec/f2c/c/zlahef.c +++ b/src/map/lapack2flamec/f2c/c/zlahef.c @@ -234,6 +234,7 @@ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex *a, w -= w_offset; /* Function Body */ *info = 0; + imax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; if (lsame_(uplo, "U")) diff --git a/src/map/lapack2flamec/f2c/c/zlahef_rk.c b/src/map/lapack2flamec/f2c/c/zlahef_rk.c index a9a250746..151865e55 100644 --- a/src/map/lapack2flamec/f2c/c/zlahef_rk.c +++ b/src/map/lapack2flamec/f2c/c/zlahef_rk.c @@ -327,6 +327,8 @@ int zlahef_rk_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex * w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; + imax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/zlahef_rook.c b/src/map/lapack2flamec/f2c/c/zlahef_rook.c index 0f1a201da..240abbdcd 100644 --- a/src/map/lapack2flamec/f2c/c/zlahef_rook.c +++ b/src/map/lapack2flamec/f2c/c/zlahef_rook.c @@ -245,6 +245,8 @@ int zlahef_rook_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; + imax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/zlahqr.c b/src/map/lapack2flamec/f2c/c/zlahqr.c index 58dceb555..05987f6c2 100644 --- a/src/map/lapack2flamec/f2c/c/zlahqr.c +++ b/src/map/lapack2flamec/f2c/c/zlahqr.c @@ -234,7 +234,7 @@ int zlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i extern /* Subroutine */ int zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); extern /* Double Complex */ - VOID zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); doublereal smlnum; /* -- LAPACK auxiliary routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -271,6 +271,7 @@ int zlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i z__ -= z_offset; /* Function Body */ *info = 0; + i2 = 0; /* Quick return if possible */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/zlahr2.c b/src/map/lapack2flamec/f2c/c/zlahr2.c index 7bd099704..8993dcc81 100644 --- a/src/map/lapack2flamec/f2c/c/zlahr2.c +++ b/src/map/lapack2flamec/f2c/c/zlahr2.c @@ -224,6 +224,8 @@ int zlahr2_(integer *n, integer *k, integer *nb, doublecomplex *a, integer *lda, y_offset = 1 + y_dim1; y -= y_offset; /* Function Body */ + ei.r = 0.; + ei.i = 0.; if (*n <= 1) { AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/f2c/c/zlals0.c b/src/map/lapack2flamec/f2c/c/zlals0.c index eb88c1b09..8d1876344 100644 --- a/src/map/lapack2flamec/f2c/c/zlals0.c +++ b/src/map/lapack2flamec/f2c/c/zlals0.c @@ -283,7 +283,7 @@ int zlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *); extern doublereal dlamc3_(doublereal *, doublereal *); extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal dsigjp; extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublecomplex *, integer *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -334,6 +334,7 @@ int zlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n /* Function Body */ *info = 0; n = *nl + *nr + 1; + difrj = 0.; if (*icompq < 0 || *icompq > 1) { *info = -1; @@ -381,7 +382,7 @@ int zlals0_(integer *icompq, integer *nl, integer *nr, integer *sqre, integer *n if (*info != 0) { i__1 = -(*info); - xerbla_("ZLALS0", &i__1); + xerbla_("ZLALS0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlalsa.c b/src/map/lapack2flamec/f2c/c/zlalsa.c index 0953b0720..8604503ec 100644 --- a/src/map/lapack2flamec/f2c/c/zlalsa.c +++ b/src/map/lapack2flamec/f2c/c/zlalsa.c @@ -271,7 +271,7 @@ int zlalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, doublec int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer jreal, inode, ndiml, ndimr; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlals0_(integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlals0_(integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -368,7 +368,7 @@ int zlalsa_(integer *icompq, integer *smlsiz, integer *n, integer *nrhs, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZLALSA", &i__1); + xerbla_("ZLALSA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlalsd.c b/src/map/lapack2flamec/f2c/c/zlalsd.c index b539483bc..f978d2940 100644 --- a/src/map/lapack2flamec/f2c/c/zlalsd.c +++ b/src/map/lapack2flamec/f2c/c/zlalsd.c @@ -218,7 +218,7 @@ int zlalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, doublereal * int dlasda_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); + int dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer givcol; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ @@ -272,7 +272,7 @@ int zlalsd_(char *uplo, integer *smlsiz, integer *n, integer *nrhs, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZLALSD", &i__1); + xerbla_("ZLALSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlamswlq.c b/src/map/lapack2flamec/f2c/c/zlamswlq.c index 94d8c37ce..b87f35603 100644 --- a/src/map/lapack2flamec/f2c/c/zlamswlq.c +++ b/src/map/lapack2flamec/f2c/c/zlamswlq.c @@ -203,7 +203,7 @@ int zlamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int zgemlqt_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztpmlqt_(char *, char *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -292,7 +292,7 @@ int zlamswlq_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAMSWLQ", &i__1); + xerbla_("ZLAMSWLQ", &i__1, (ftnlen)8); work[1].r = (doublereal) lw; work[1].i = 0.; // , expr subst AOCL_DTL_TRACE_LOG_EXIT diff --git a/src/map/lapack2flamec/f2c/c/zlamtsqr.c b/src/map/lapack2flamec/f2c/c/zlamtsqr.c index 011d855d6..bc16e7cd4 100644 --- a/src/map/lapack2flamec/f2c/c/zlamtsqr.c +++ b/src/map/lapack2flamec/f2c/c/zlamtsqr.c @@ -208,7 +208,7 @@ int zlamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, lquery; extern /* Subroutine */ int zgemqrt_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -305,7 +305,7 @@ int zlamtsqr_(char *side, char *trans, integer *m, integer * n, integer *k, inte if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAMTSQR", &i__1); + xerbla_("ZLAMTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlangb.c b/src/map/lapack2flamec/f2c/c/zlangb.c index 95e9153df..4a3d1acbb 100644 --- a/src/map/lapack2flamec/f2c/c/zlangb.c +++ b/src/map/lapack2flamec/f2c/c/zlangb.c @@ -153,6 +153,7 @@ doublereal zlangb_(char *norm, integer *n, integer *kl, integer *ku, doublecompl ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlange.c b/src/map/lapack2flamec/f2c/c/zlange.c index edab530db..f68074e08 100644 --- a/src/map/lapack2flamec/f2c/c/zlange.c +++ b/src/map/lapack2flamec/f2c/c/zlange.c @@ -146,6 +146,7 @@ doublereal zlange_(char *norm, integer *m, integer *n, doublecomplex *a, integer a -= a_offset; --work; /* Function Body */ + value = 0.; if (fla_min(*m,*n) == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlangt.c b/src/map/lapack2flamec/f2c/c/zlangt.c index 191242671..4d4e09ca0 100644 --- a/src/map/lapack2flamec/f2c/c/zlangt.c +++ b/src/map/lapack2flamec/f2c/c/zlangt.c @@ -136,6 +136,7 @@ doublereal zlangt_(char *norm, integer *n, doublecomplex *dl, doublecomplex * d_ --d__; --dl; /* Function Body */ + anorm = 0.; if (*n <= 0) { anorm = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanhb.c b/src/map/lapack2flamec/f2c/c/zlanhb.c index 378d53313..a3b210e83 100644 --- a/src/map/lapack2flamec/f2c/c/zlanhb.c +++ b/src/map/lapack2flamec/f2c/c/zlanhb.c @@ -161,6 +161,7 @@ doublereal zlanhb_(char *norm, char *uplo, integer *n, integer *k, doublecomplex ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanhe.c b/src/map/lapack2flamec/f2c/c/zlanhe.c index 129aa82a0..789282cce 100644 --- a/src/map/lapack2flamec/f2c/c/zlanhe.c +++ b/src/map/lapack2flamec/f2c/c/zlanhe.c @@ -153,6 +153,7 @@ doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a, integer a -= a_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanhf.c b/src/map/lapack2flamec/f2c/c/zlanhf.c index 4b321bfbd..b53a71c3b 100644 --- a/src/map/lapack2flamec/f2c/c/zlanhf.c +++ b/src/map/lapack2flamec/f2c/c/zlanhf.c @@ -278,6 +278,7 @@ doublereal zlanhf_(char *norm, char *transr, char *uplo, integer *n, doublecompl /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + value = 0.; if (*n == 0) { ret_val = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanhp.c b/src/map/lapack2flamec/f2c/c/zlanhp.c index eec9cfe74..25dc692d5 100644 --- a/src/map/lapack2flamec/f2c/c/zlanhp.c +++ b/src/map/lapack2flamec/f2c/c/zlanhp.c @@ -145,6 +145,7 @@ doublereal zlanhp_(char *norm, char *uplo, integer *n, doublecomplex *ap, double --work; --ap; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanhs.c b/src/map/lapack2flamec/f2c/c/zlanhs.c index da718fc88..6e26b750c 100644 --- a/src/map/lapack2flamec/f2c/c/zlanhs.c +++ b/src/map/lapack2flamec/f2c/c/zlanhs.c @@ -139,6 +139,7 @@ doublereal zlanhs_(char *norm, integer *n, doublecomplex *a, integer *lda, doubl a -= a_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlanht.c b/src/map/lapack2flamec/f2c/c/zlanht.c index 597cb32c9..3a61482ef 100644 --- a/src/map/lapack2flamec/f2c/c/zlanht.c +++ b/src/map/lapack2flamec/f2c/c/zlanht.c @@ -130,6 +130,7 @@ doublereal zlanht_(char *norm, integer *n, doublereal *d__, doublecomplex *e) --e; --d__; /* Function Body */ + anorm = 0.; if (*n <= 0) { anorm = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlansb.c b/src/map/lapack2flamec/f2c/c/zlansb.c index f531e5368..a8d3efea1 100644 --- a/src/map/lapack2flamec/f2c/c/zlansb.c +++ b/src/map/lapack2flamec/f2c/c/zlansb.c @@ -159,6 +159,7 @@ doublereal zlansb_(char *norm, char *uplo, integer *n, integer *k, doublecomplex ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlansp.c b/src/map/lapack2flamec/f2c/c/zlansp.c index c31232044..c6a14e3cb 100644 --- a/src/map/lapack2flamec/f2c/c/zlansp.c +++ b/src/map/lapack2flamec/f2c/c/zlansp.c @@ -143,6 +143,7 @@ doublereal zlansp_(char *norm, char *uplo, integer *n, doublecomplex *ap, double --work; --ap; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlansy.c b/src/map/lapack2flamec/f2c/c/zlansy.c index be93f6f7d..9afbcb958 100644 --- a/src/map/lapack2flamec/f2c/c/zlansy.c +++ b/src/map/lapack2flamec/f2c/c/zlansy.c @@ -152,6 +152,7 @@ doublereal zlansy_(char *norm, char *uplo, integer *n, doublecomplex *a, integer a -= a_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlantb.c b/src/map/lapack2flamec/f2c/c/zlantb.c index 8e89ee406..b9a6cf2cd 100644 --- a/src/map/lapack2flamec/f2c/c/zlantb.c +++ b/src/map/lapack2flamec/f2c/c/zlantb.c @@ -171,6 +171,7 @@ doublereal zlantb_(char *norm, char *uplo, char *diag, integer *n, integer *k, d ab -= ab_offset; --work; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlantp.c b/src/map/lapack2flamec/f2c/c/zlantp.c index 580450b66..09619f843 100644 --- a/src/map/lapack2flamec/f2c/c/zlantp.c +++ b/src/map/lapack2flamec/f2c/c/zlantp.c @@ -154,6 +154,7 @@ doublereal zlantp_(char *norm, char *uplo, char *diag, integer *n, doublecomplex --work; --ap; /* Function Body */ + value = 0.; if (*n == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlantr.c b/src/map/lapack2flamec/f2c/c/zlantr.c index a4f9d43c9..fb7b35c4c 100644 --- a/src/map/lapack2flamec/f2c/c/zlantr.c +++ b/src/map/lapack2flamec/f2c/c/zlantr.c @@ -171,6 +171,7 @@ doublereal zlantr_(char *norm, char *uplo, char *diag, integer *m, integer *n, d a -= a_offset; --work; /* Function Body */ + value = 0.; if (fla_min(*m,*n) == 0) { value = 0.; diff --git a/src/map/lapack2flamec/f2c/c/zlaqr0.c b/src/map/lapack2flamec/f2c/c/zlaqr0.c index 15ce66e7f..73885aac3 100644 --- a/src/map/lapack2flamec/f2c/c/zlaqr0.c +++ b/src/map/lapack2flamec/f2c/c/zlaqr0.c @@ -318,6 +318,7 @@ int zlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/zlaqr4.c b/src/map/lapack2flamec/f2c/c/zlaqr4.c index f90f98e65..9891d299c 100644 --- a/src/map/lapack2flamec/f2c/c/zlaqr4.c +++ b/src/map/lapack2flamec/f2c/c/zlaqr4.c @@ -324,6 +324,7 @@ int zlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *i --work; /* Function Body */ *info = 0; + ndec = 0; /* ==== Quick return for N = 0: nothing to do. ==== */ if (*n == 0) { diff --git a/src/map/lapack2flamec/f2c/c/zlaqz0.c b/src/map/lapack2flamec/f2c/c/zlaqz0.c index c24f6779a..7c7a1b1a0 100644 --- a/src/map/lapack2flamec/f2c/c/zlaqz0.c +++ b/src/map/lapack2flamec/f2c/c/zlaqz0.c @@ -331,7 +331,7 @@ int zlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in integer nibble, nblock; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); doublecomplex eshift; @@ -374,6 +374,8 @@ int zlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in --work; --rwork; /* Function Body */ + eshift.r = 0.; + eshift.i = 0.; if (lsame_(wants, "E")) { ilschur = FALSE_; @@ -471,7 +473,7 @@ int zlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAQZ0", &i__1); + xerbla_("ZLAQZ0", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -546,7 +548,7 @@ int zlaqz0_(char *wants, char *wantq, char *wantz, integer * n, integer *ilo, in } if (*info != 0) { - xerbla_("ZLAQZ0", info); + xerbla_("ZLAQZ0", info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaqz2.c b/src/map/lapack2flamec/f2c/c/zlaqz2.c index cd7cebf30..b419a9f00 100644 --- a/src/map/lapack2flamec/f2c/c/zlaqz2.c +++ b/src/map/lapack2flamec/f2c/c/zlaqz2.c @@ -265,7 +265,7 @@ int zlaqz2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), ztgexc_( logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *); @@ -348,7 +348,7 @@ int zlaqz2_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAQZ2", &i__1); + xerbla_("ZLAQZ2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaqz3.c b/src/map/lapack2flamec/f2c/c/zlaqz3.c index ba000792c..d657a5c67 100644 --- a/src/map/lapack2flamec/f2c/c/zlaqz3.c +++ b/src/map/lapack2flamec/f2c/c/zlaqz3.c @@ -229,7 +229,7 @@ int zlaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i integer nblock; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal safmax; integer ishift, istopb, swidth; extern /* Subroutine */ @@ -283,7 +283,7 @@ int zlaqz3_(logical *ilschur, logical *ilq, logical *ilz, integer *n, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAQZ3", &i__1); + xerbla_("ZLAQZ3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlarfg.c b/src/map/lapack2flamec/f2c/c/zlarfg.c index 02f7163f3..9a9a1a028 100644 --- a/src/map/lapack2flamec/f2c/c/zlarfg.c +++ b/src/map/lapack2flamec/f2c/c/zlarfg.c @@ -122,7 +122,7 @@ int zlarfg_(integer *n, doublecomplex *alpha, doublecomplex * x, integer *incx, int zdscal_(integer *, doublereal *, doublecomplex *, integer *); doublereal rsafmn; extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); extern int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); extern int fla_zscal(integer *, doublecomplex *, doublecomplex *, integer *); /* -- LAPACK auxiliary routine (version 3.8.0) -- */ diff --git a/src/map/lapack2flamec/f2c/c/zlarfgp.c b/src/map/lapack2flamec/f2c/c/zlarfgp.c index 55e3400f7..d47f3368f 100644 --- a/src/map/lapack2flamec/f2c/c/zlarfgp.c +++ b/src/map/lapack2flamec/f2c/c/zlarfgp.c @@ -120,7 +120,7 @@ int zlarfgp_(integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx, int zdscal_(integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); doublereal smlnum; /* -- LAPACK auxiliary routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ diff --git a/src/map/lapack2flamec/f2c/c/zlarrv.c b/src/map/lapack2flamec/f2c/c/zlarrv.c index c4770c3fa..d843e316f 100644 --- a/src/map/lapack2flamec/f2c/c/zlarrv.c +++ b/src/map/lapack2flamec/f2c/c/zlarrv.c @@ -299,7 +299,6 @@ int zlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler doublereal ztz; integer iend, jblk; doublereal lgap; - integer done; doublereal rgap, left; integer wend, iter; doublereal bstw; @@ -466,8 +465,6 @@ int zlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler /* entries is contained in the interval IBEGIN:IEND. */ /* Remark that if k eigenpairs are desired, then the eigenvectors */ /* are stored in k contiguous columns of Z. */ - /* DONE is the number of eigenvectors already computed */ - done = 0; ibegin = 1; wbegin = 1; i__1 = iblock[*m]; @@ -526,7 +523,6 @@ int zlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler /* This is for a 1x1 block */ if (ibegin == iend) { - ++done; i__2 = ibegin + wbegin * z_dim1; z__[i__2].r = 1.; z__[i__2].i = 0.; // , expr subst @@ -913,7 +909,6 @@ int zlarrv_(integer *n, doublereal *vl, doublereal *vu, doublereal *d__, doubler i__4 = windex + 1; windpl = fla_min(i__4,*m); lambda = work[windex]; - ++done; /* Check if eigenvector computation is to be skipped */ if (windex < *dol || windex > *dou) { diff --git a/src/map/lapack2flamec/f2c/c/zlarzb.c b/src/map/lapack2flamec/f2c/c/zlarzb.c index 6e64886ed..c5778472d 100644 --- a/src/map/lapack2flamec/f2c/c/zlarzb.c +++ b/src/map/lapack2flamec/f2c/c/zlarzb.c @@ -189,7 +189,7 @@ int zlarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in integer i__, j, info; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); char transt[1]; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -242,7 +242,7 @@ int zlarzb_(char *side, char *trans, char *direct, char * storev, integer *m, in if (info != 0) { i__1 = -info; - xerbla_("ZLARZB", &i__1); + xerbla_("ZLARZB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlarzt.c b/src/map/lapack2flamec/f2c/c/zlarzt.c index 4c6f3bbab..61bff5c42 100644 --- a/src/map/lapack2flamec/f2c/c/zlarzt.c +++ b/src/map/lapack2flamec/f2c/c/zlarzt.c @@ -193,7 +193,7 @@ int zlarzt_(char *direct, char *storev, integer *n, integer * k, doublecomplex * integer i__, j, info; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -234,7 +234,7 @@ int zlarzt_(char *direct, char *storev, integer *n, integer * k, doublecomplex * if (info != 0) { i__1 = -info; - xerbla_("ZLARZT", &i__1); + xerbla_("ZLARZT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlascl.c b/src/map/lapack2flamec/f2c/c/zlascl.c index adc4d4048..797957a08 100644 --- a/src/map/lapack2flamec/f2c/c/zlascl.c +++ b/src/map/lapack2flamec/f2c/c/zlascl.c @@ -150,7 +150,7 @@ int zlascl_(char *type__, integer *kl, integer *ku, doublereal *cfrom, doublerea doublereal cfromc; extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; /* -- LAPACK auxiliary routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -259,7 +259,7 @@ int zlascl_(char *type__, integer *kl, integer *ku, doublereal *cfrom, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("ZLASCL", &i__1); + xerbla_("ZLASCL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlasr.c b/src/map/lapack2flamec/f2c/c/zlasr.c index 0d0a150a5..ccfdccb0f 100644 --- a/src/map/lapack2flamec/f2c/c/zlasr.c +++ b/src/map/lapack2flamec/f2c/c/zlasr.c @@ -200,7 +200,7 @@ int zlasr_(char *side, char *pivot, char *direct, integer *m, integer *n, double extern logical lsame_(char *, char *); doublereal ctemp, stemp; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -256,7 +256,7 @@ int zlasr_(char *side, char *pivot, char *direct, integer *m, integer *n, double } if (info != 0) { - xerbla_("ZLASR ", &info); + xerbla_("ZLASR ", &info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlassq.c b/src/map/lapack2flamec/f2c/c/zlassq.c index 084d35aa5..0dd2bd114 100644 --- a/src/map/lapack2flamec/f2c/c/zlassq.c +++ b/src/map/lapack2flamec/f2c/c/zlassq.c @@ -126,6 +126,7 @@ int zlassq_(integer *n, doublecomplex *x, integer *incx, doublereal *scl, double tbig = 1.9979190722022350E+146; ssml = 4.4989137945431964E+161; sbig = 1.1113793747425387E-162; + sbi = 0.; /* .. */ /* Quick return if possible */ if (disnan_(scl) || disnan_(sumsq)) { diff --git a/src/map/lapack2flamec/f2c/c/zlaswlq.c b/src/map/lapack2flamec/f2c/c/zlaswlq.c index 7c89493b8..7d4d0f92a 100644 --- a/src/map/lapack2flamec/f2c/c/zlaswlq.c +++ b/src/map/lapack2flamec/f2c/c/zlaswlq.c @@ -166,7 +166,7 @@ int zlaswlq_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex *a /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), zgelqt_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgelqt_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical lquery; extern /* Subroutine */ int ztplqt_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -235,7 +235,7 @@ int zlaswlq_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZLASWLQ", &i__1); + xerbla_("ZLASWLQ", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlasyf_rk.c b/src/map/lapack2flamec/f2c/c/zlasyf_rk.c index 681781912..71ce1863e 100644 --- a/src/map/lapack2flamec/f2c/c/zlasyf_rk.c +++ b/src/map/lapack2flamec/f2c/c/zlasyf_rk.c @@ -323,6 +323,7 @@ int zlasyf_rk_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex * w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/zlasyf_rook.c b/src/map/lapack2flamec/f2c/c/zlasyf_rook.c index 4beac6a52..f92e8b075 100644 --- a/src/map/lapack2flamec/f2c/c/zlasyf_rook.c +++ b/src/map/lapack2flamec/f2c/c/zlasyf_rook.c @@ -241,6 +241,7 @@ int zlasyf_rook_(char *uplo, integer *n, integer *nb, integer *kb, doublecomplex w -= w_offset; /* Function Body */ *info = 0; + jmax = 0; /* Initialize ALPHA for use in choosing pivot block size. */ alpha = (sqrt(17.) + 1.) / 8.; /* Compute machine safe minimum */ diff --git a/src/map/lapack2flamec/f2c/c/zlatbs.c b/src/map/lapack2flamec/f2c/c/zlatbs.c index f9924db4d..e630f15f9 100644 --- a/src/map/lapack2flamec/f2c/c/zlatbs.c +++ b/src/map/lapack2flamec/f2c/c/zlatbs.c @@ -274,11 +274,11 @@ int zlatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Double Complex */ - VOID zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); logical notran; integer jfirst; extern doublereal dzasum_(integer *, doublecomplex *, integer *); @@ -350,7 +350,7 @@ int zlatbs_(char *uplo, char *trans, char *diag, char * normin, integer *n, inte if (*info != 0) { i__1 = -(*info); - xerbla_("ZLATBS", &i__1); + xerbla_("ZLATBS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlatps.c b/src/map/lapack2flamec/f2c/c/zlatps.c index d6542ad9f..8b332745b 100644 --- a/src/map/lapack2flamec/f2c/c/zlatps.c +++ b/src/map/lapack2flamec/f2c/c/zlatps.c @@ -263,11 +263,11 @@ int zlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); logical notran; integer jfirst; extern doublereal dzasum_(integer *, doublecomplex *, integer *); @@ -330,7 +330,7 @@ int zlatps_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZLATPS", &i__1); + xerbla_("ZLATPS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlatrs.c b/src/map/lapack2flamec/f2c/c/zlatrs.c index 89d57011d..91259ebf2 100644 --- a/src/map/lapack2flamec/f2c/c/zlatrs.c +++ b/src/map/lapack2flamec/f2c/c/zlatrs.c @@ -268,11 +268,11 @@ int zlatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub extern doublereal dlamch_(char *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); doublereal bignum; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Double Complex */ - VOID zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); logical notran; integer jfirst; extern doublereal dzasum_(integer *, doublecomplex *, integer *); @@ -340,7 +340,7 @@ int zlatrs_(char *uplo, char *trans, char *diag, char * normin, integer *n, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZLATRS", &i__1); + xerbla_("ZLATRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlatrs3.c b/src/map/lapack2flamec/f2c/c/zlatrs3.c index 517fcbe22..206fae66f 100644 --- a/src/map/lapack2flamec/f2c/c/zlatrs3.c +++ b/src/map/lapack2flamec/f2c/c/zlatrs3.c @@ -248,7 +248,7 @@ int zlatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int doublereal scaloc, scamin; extern doublereal dlarmm_(doublereal *, doublereal *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -369,7 +369,7 @@ int zlatrs3_(char *uplo, char *trans, char *diag, char * normin, integer *n, int if (*info != 0) { i__1 = -(*info); - xerbla_("ZLATRS3", &i__1); + xerbla_("ZLATRS3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlatsqr.c b/src/map/lapack2flamec/f2c/c/zlatsqr.c index 2f27432bf..2a0fddbd2 100644 --- a/src/map/lapack2flamec/f2c/c/zlatsqr.c +++ b/src/map/lapack2flamec/f2c/c/zlatsqr.c @@ -168,7 +168,7 @@ int zlatsqr_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex *a /* Local variables */ integer i__, ii, kk, ctr; extern /* Subroutine */ - int xerbla_(char *, integer *), zgeqrt_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgeqrt_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical lquery; extern /* Subroutine */ int ztpqrt_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -237,7 +237,7 @@ int zlatsqr_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZLATSQR", &i__1); + xerbla_("ZLATSQR", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp.c b/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp.c index 5848773cf..c0697ce4c 100644 --- a/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp.c +++ b/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp.c @@ -156,7 +156,7 @@ int zlaunhr_col_getrfnp_(integer *m, integer *n, doublecomplex *a, integer *lda, int zlaunhr_col_getrfnp2_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); integer iinfo; extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -201,7 +201,7 @@ int zlaunhr_col_getrfnp_(integer *m, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAUNHR_COL_GETRFNP", &i__1); + xerbla_("ZLAUNHR_COL_GETRFNP", &i__1, (ftnlen)19); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp2.c b/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp2.c index 9fea07923..039d09418 100644 --- a/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp2.c +++ b/src/map/lapack2flamec/f2c/c/zlaunhr_col_getrfnp2.c @@ -182,7 +182,7 @@ int zlaunhr_col_getrfnp2_(integer *m, integer *n, doublecomplex *a, integer *lda int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -230,7 +230,7 @@ int zlaunhr_col_getrfnp2_(integer *m, integer *n, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZLAUNHR_COL_GETRFNP2", &i__1); + xerbla_("ZLAUNHR_COL_GETRFNP2", &i__1, (ftnlen)20); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbcon.c b/src/map/lapack2flamec/f2c/c/zpbcon.c index 49d81f2ec..b2e08ed40 100644 --- a/src/map/lapack2flamec/f2c/c/zpbcon.c +++ b/src/map/lapack2flamec/f2c/c/zpbcon.c @@ -143,7 +143,7 @@ int zpbcon_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda extern doublereal dlamch_(char *); doublereal scalel, scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ @@ -209,7 +209,7 @@ int zpbcon_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBCON", &i__1); + xerbla_("ZPBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbequ.c b/src/map/lapack2flamec/f2c/c/zpbequ.c index 4c5ef69f0..b84c1c414 100644 --- a/src/map/lapack2flamec/f2c/c/zpbequ.c +++ b/src/map/lapack2flamec/f2c/c/zpbequ.c @@ -134,7 +134,7 @@ int zpbequ_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -183,7 +183,7 @@ int zpbequ_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBEQU", &i__1); + xerbla_("ZPBEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbrfs.c b/src/map/lapack2flamec/f2c/c/zpbrfs.c index a6580ac19..b7e86c03a 100644 --- a/src/map/lapack2flamec/f2c/c/zpbrfs.c +++ b/src/map/lapack2flamec/f2c/c/zpbrfs.c @@ -211,7 +211,7 @@ int zpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex * extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zpbtrs_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -297,7 +297,7 @@ int zpbrfs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBRFS", &i__1); + xerbla_("ZPBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbstf.c b/src/map/lapack2flamec/f2c/c/zpbstf.c index ae11df9d7..bbba7a36c 100644 --- a/src/map/lapack2flamec/f2c/c/zpbstf.c +++ b/src/map/lapack2flamec/f2c/c/zpbstf.c @@ -165,7 +165,7 @@ int zpbstf_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *), zlacgv_( integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -213,7 +213,7 @@ int zpbstf_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBSTF", &i__1); + xerbla_("ZPBSTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbsv.c b/src/map/lapack2flamec/f2c/c/zpbsv.c index 89e204225..752b7e3e6 100644 --- a/src/map/lapack2flamec/f2c/c/zpbsv.c +++ b/src/map/lapack2flamec/f2c/c/zpbsv.c @@ -162,7 +162,7 @@ int zpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex *a /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zpbtrf_( char *, integer *, integer *, doublecomplex *, integer *, integer *), zpbtrs_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zpbtrf_( char *, integer *, integer *, doublecomplex *, integer *, integer *), zpbtrs_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -216,7 +216,7 @@ int zpbsv_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBSV ", &i__1); + xerbla_("ZPBSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbsvx.c b/src/map/lapack2flamec/f2c/c/zpbsvx.c index 94591258f..d8f84e979 100644 --- a/src/map/lapack2flamec/f2c/c/zpbsvx.c +++ b/src/map/lapack2flamec/f2c/c/zpbsvx.c @@ -353,7 +353,7 @@ int zpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanhb_(char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; extern /* Subroutine */ @@ -407,6 +407,8 @@ int zpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); upper = lsame_(uplo, "U"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -500,7 +502,7 @@ int zpbsvx_(char *fact, char *uplo, integer *n, integer *kd, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBSVX", &i__1); + xerbla_("ZPBSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbtf2.c b/src/map/lapack2flamec/f2c/c/zpbtf2.c index 6890a335c..4010c1b16 100644 --- a/src/map/lapack2flamec/f2c/c/zpbtf2.c +++ b/src/map/lapack2flamec/f2c/c/zpbtf2.c @@ -151,7 +151,7 @@ int zpbtf2_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *), zlacgv_( integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -199,7 +199,7 @@ int zpbtf2_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBTF2", &i__1); + xerbla_("ZPBTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbtrf.c b/src/map/lapack2flamec/f2c/c/zpbtrf.c index 2b17bd672..3dd3bf508 100644 --- a/src/map/lapack2flamec/f2c/c/zpbtrf.c +++ b/src/map/lapack2flamec/f2c/c/zpbtrf.c @@ -153,7 +153,7 @@ int zpbtrf_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda ; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zherk_(char *, char *, integer *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zpbtf2_(char *, integer *, integer *, doublecomplex *, integer *, integer *), zpotf2_(char *, integer *, doublecomplex *, integer *, integer *), xerbla_(char *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zherk_(char *, char *, integer *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zpbtf2_(char *, integer *, integer *, doublecomplex *, integer *, integer *), zpotf2_(char *, integer *, doublecomplex *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -203,7 +203,7 @@ int zpbtrf_(char *uplo, integer *n, integer *kd, doublecomplex *ab, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBTRF", &i__1); + xerbla_("ZPBTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpbtrs.c b/src/map/lapack2flamec/f2c/c/zpbtrs.c index 4bd0448b1..30f32fc84 100644 --- a/src/map/lapack2flamec/f2c/c/zpbtrs.c +++ b/src/map/lapack2flamec/f2c/c/zpbtrs.c @@ -123,7 +123,7 @@ int zpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex * extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -180,7 +180,7 @@ int zpbtrs_(char *uplo, integer *n, integer *kd, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZPBTRS", &i__1); + xerbla_("ZPBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpftrf.c b/src/map/lapack2flamec/f2c/c/zpftrf.c index b11b27c83..f1b9fd71d 100644 --- a/src/map/lapack2flamec/f2c/c/zpftrf.c +++ b/src/map/lapack2flamec/f2c/c/zpftrf.c @@ -225,7 +225,7 @@ int zpftrf_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *inf int zherk_(char *, char *, integer *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); logical lower; extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int zpotrf_(char *, integer *, doublecomplex *, integer *, integer *); @@ -267,7 +267,7 @@ int zpftrf_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZPFTRF", &i__1); + xerbla_("ZPFTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpftri.c b/src/map/lapack2flamec/f2c/c/zpftri.c index ad640636a..af90fc8b6 100644 --- a/src/map/lapack2flamec/f2c/c/zpftri.c +++ b/src/map/lapack2flamec/f2c/c/zpftri.c @@ -225,7 +225,7 @@ int zpftri_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *inf int zherk_(char *, char *, integer *, integer *, doublereal *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *); logical lower; extern /* Subroutine */ - int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int zlauum_(char *, integer *, doublecomplex *, integer *, integer *), ztftri_(char *, char *, char *, integer *, doublecomplex *, integer *); @@ -267,7 +267,7 @@ int zpftri_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *inf if (*info != 0) { i__1 = -(*info); - xerbla_("ZPFTRI", &i__1); + xerbla_("ZPFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpftrs.c b/src/map/lapack2flamec/f2c/c/zpftrs.c index bfed62ed8..05be3b727 100644 --- a/src/map/lapack2flamec/f2c/c/zpftrs.c +++ b/src/map/lapack2flamec/f2c/c/zpftrs.c @@ -227,7 +227,7 @@ int zpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, doublecomplex extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int ztfsm_(char *, char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztfsm_(char *, char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -280,7 +280,7 @@ int zpftrs_(char *transr, char *uplo, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZPFTRS", &i__1); + xerbla_("ZPFTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpocon.c b/src/map/lapack2flamec/f2c/c/zpocon.c index 62f55ed36..91f4107bc 100644 --- a/src/map/lapack2flamec/f2c/c/zpocon.c +++ b/src/map/lapack2flamec/f2c/c/zpocon.c @@ -130,7 +130,7 @@ int zpocon_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * extern doublereal dlamch_(char *); doublereal scalel, scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ @@ -194,7 +194,7 @@ int zpocon_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOCON", &i__1); + xerbla_("ZPOCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpoequ.c b/src/map/lapack2flamec/f2c/c/zpoequ.c index e7e8de8e2..bbda43f63 100644 --- a/src/map/lapack2flamec/f2c/c/zpoequ.c +++ b/src/map/lapack2flamec/f2c/c/zpoequ.c @@ -113,7 +113,7 @@ int zpoequ_(integer *n, doublecomplex *a, integer *lda, doublereal *s, doublerea integer i__; doublereal smin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -151,7 +151,7 @@ int zpoequ_(integer *n, doublecomplex *a, integer *lda, doublereal *s, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOEQU", &i__1); + xerbla_("ZPOEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpoequb.c b/src/map/lapack2flamec/f2c/c/zpoequb.c index e54039a29..6a552760f 100644 --- a/src/map/lapack2flamec/f2c/c/zpoequb.c +++ b/src/map/lapack2flamec/f2c/c/zpoequb.c @@ -113,7 +113,7 @@ int zpoequb_(integer *n, doublecomplex *a, integer *lda, doublereal *s, doublere doublereal tmp, base, smin; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int zpoequb_(integer *n, doublecomplex *a, integer *lda, doublereal *s, doublere if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOEQUB", &i__1); + xerbla_("ZPOEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zporfs.c b/src/map/lapack2flamec/f2c/c/zporfs.c index 48723c4b4..326f5c295 100644 --- a/src/map/lapack2flamec/f2c/c/zporfs.c +++ b/src/map/lapack2flamec/f2c/c/zporfs.c @@ -203,7 +203,7 @@ int zporfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -285,7 +285,7 @@ int zporfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZPORFS", &i__1); + xerbla_("ZPORFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zporfsx.c b/src/map/lapack2flamec/f2c/c/zporfsx.c index 811a04672..16367992e 100644 --- a/src/map/lapack2flamec/f2c/c/zporfsx.c +++ b/src/map/lapack2flamec/f2c/c/zporfsx.c @@ -411,7 +411,7 @@ int zporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex logical rcequ; extern doublereal zla_porcond_c_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, logical *, integer *, doublecomplex *, doublereal *), zla_porcond_x_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zpocon_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *); @@ -561,7 +561,7 @@ int zporfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZPORFSX", &i__1); + xerbla_("ZPORFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zposv.c b/src/map/lapack2flamec/f2c/c/zposv.c index 7846cc441..68753384a 100644 --- a/src/map/lapack2flamec/f2c/c/zposv.c +++ b/src/map/lapack2flamec/f2c/c/zposv.c @@ -127,7 +127,7 @@ int zposv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zpotrf_( char *, integer *, doublecomplex *, integer *, integer *), zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zpotrf_( char *, integer *, doublecomplex *, integer *, integer *), zpotrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -177,7 +177,7 @@ int zposv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOSV ", &i__1); + xerbla_("ZPOSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zposvx.c b/src/map/lapack2flamec/f2c/c/zposvx.c index 524afc6c5..2467cd492 100644 --- a/src/map/lapack2flamec/f2c/c/zposvx.c +++ b/src/map/lapack2flamec/f2c/c/zposvx.c @@ -312,7 +312,7 @@ int zposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ @@ -365,6 +365,8 @@ int zposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -454,7 +456,7 @@ int zposvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOSVX", &i__1); + xerbla_("ZPOSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zposvxx.c b/src/map/lapack2flamec/f2c/c/zposvxx.c index 4d970039a..adf254941 100644 --- a/src/map/lapack2flamec/f2c/c/zposvxx.c +++ b/src/map/lapack2flamec/f2c/c/zposvxx.c @@ -504,7 +504,7 @@ int zposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; extern /* Subroutine */ int zlaqhe_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, char *); @@ -655,7 +655,7 @@ int zposvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOSVXX", &i__1); + xerbla_("ZPOSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpotrf2.c b/src/map/lapack2flamec/f2c/c/zpotrf2.c index f7338aa86..b6bd7441c 100644 --- a/src/map/lapack2flamec/f2c/c/zpotrf2.c +++ b/src/map/lapack2flamec/f2c/c/zpotrf2.c @@ -123,7 +123,7 @@ int zpotrf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *in int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -167,7 +167,7 @@ int zpotrf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *in if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOTRF2", &i__1); + xerbla_("ZPOTRF2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpotrs.c b/src/map/lapack2flamec/f2c/c/zpotrs.c index 5bc177d4a..03549e077 100644 --- a/src/map/lapack2flamec/f2c/c/zpotrs.c +++ b/src/map/lapack2flamec/f2c/c/zpotrs.c @@ -114,7 +114,7 @@ int zpotrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -169,7 +169,7 @@ int zpotrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZPOTRS", &i__1); + xerbla_("ZPOTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zppcon.c b/src/map/lapack2flamec/f2c/c/zppcon.c index 4ed26b8db..4f180b122 100644 --- a/src/map/lapack2flamec/f2c/c/zppcon.c +++ b/src/map/lapack2flamec/f2c/c/zppcon.c @@ -129,7 +129,7 @@ int zppcon_(char *uplo, integer *n, doublecomplex *ap, doublereal *anorm, double extern doublereal dlamch_(char *); doublereal scalel, scaleu; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); extern /* Subroutine */ @@ -187,7 +187,7 @@ int zppcon_(char *uplo, integer *n, doublecomplex *ap, doublereal *anorm, double if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPCON", &i__1); + xerbla_("ZPPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zppequ.c b/src/map/lapack2flamec/f2c/c/zppequ.c index 17762fd52..ec6ba5119 100644 --- a/src/map/lapack2flamec/f2c/c/zppequ.c +++ b/src/map/lapack2flamec/f2c/c/zppequ.c @@ -121,7 +121,7 @@ int zppequ_(char *uplo, integer *n, doublecomplex *ap, doublereal *s, doublereal extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -160,7 +160,7 @@ int zppequ_(char *uplo, integer *n, doublecomplex *ap, doublereal *s, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPEQU", &i__1); + xerbla_("ZPPEQU", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpprfs.c b/src/map/lapack2flamec/f2c/c/zpprfs.c index 79e0232af..bf27e8d11 100644 --- a/src/map/lapack2flamec/f2c/c/zpprfs.c +++ b/src/map/lapack2flamec/f2c/c/zpprfs.c @@ -192,7 +192,7 @@ int zpprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zpptrs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -262,7 +262,7 @@ int zpprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPRFS", &i__1); + xerbla_("ZPPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zppsv.c b/src/map/lapack2flamec/f2c/c/zppsv.c index 026e61224..abfc8e82e 100644 --- a/src/map/lapack2flamec/f2c/c/zppsv.c +++ b/src/map/lapack2flamec/f2c/c/zppsv.c @@ -142,7 +142,7 @@ int zppsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecompl /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zpptrf_( char *, integer *, doublecomplex *, integer *), zpptrs_( char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zpptrf_( char *, integer *, doublecomplex *, integer *), zpptrs_( char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -186,7 +186,7 @@ int zppsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPSV ", &i__1); + xerbla_("ZPPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zppsvx.c b/src/map/lapack2flamec/f2c/c/zppsvx.c index 01441f008..5b7f91544 100644 --- a/src/map/lapack2flamec/f2c/c/zppsvx.c +++ b/src/map/lapack2flamec/f2c/c/zppsvx.c @@ -323,7 +323,7 @@ int zppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer infequ; extern doublereal zlanhp_(char *, char *, integer *, doublecomplex *, doublereal *); @@ -370,6 +370,8 @@ int zppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a *info = 0; nofact = lsame_(fact, "N"); equil = lsame_(fact, "E"); + smlnum = 0.; + bignum = 0.; if (nofact || equil) { *(unsigned char *)equed = 'N'; @@ -451,7 +453,7 @@ int zppsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPSVX", &i__1); + xerbla_("ZPPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpptrf.c b/src/map/lapack2flamec/f2c/c/zpptrf.c index f0b2d824d..e3ef52c01 100644 --- a/src/map/lapack2flamec/f2c/c/zpptrf.c +++ b/src/map/lapack2flamec/f2c/c/zpptrf.c @@ -131,7 +131,7 @@ int zpptrf_(char *uplo, integer *n, doublecomplex *ap, integer *info) VOID zdotc_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *); + int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -169,7 +169,7 @@ int zpptrf_(char *uplo, integer *n, doublecomplex *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPTRF", &i__1); + xerbla_("ZPPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpptri.c b/src/map/lapack2flamec/f2c/c/zpptri.c index 806eee8d7..b07398752 100644 --- a/src/map/lapack2flamec/f2c/c/zpptri.c +++ b/src/map/lapack2flamec/f2c/c/zpptri.c @@ -104,7 +104,7 @@ int zpptri_(char *uplo, integer *n, doublecomplex *ap, integer *info) VOID zdotc_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), ztptri_(char *, char *, integer *, doublecomplex *, integer *); + int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), ztptri_(char *, char *, integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -142,7 +142,7 @@ int zpptri_(char *uplo, integer *n, doublecomplex *ap, integer *info) if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPTRI", &i__1); + xerbla_("ZPPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpptrs.c b/src/map/lapack2flamec/f2c/c/zpptrs.c index 9e1e7b8e5..0c961d5f6 100644 --- a/src/map/lapack2flamec/f2c/c/zpptrs.c +++ b/src/map/lapack2flamec/f2c/c/zpptrs.c @@ -110,7 +110,7 @@ int zpptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -157,7 +157,7 @@ int zpptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZPPTRS", &i__1); + xerbla_("ZPPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpstf2.c b/src/map/lapack2flamec/f2c/c/zpstf2.c index 25c6e1ae1..7fb7bcbbf 100644 --- a/src/map/lapack2flamec/f2c/c/zpstf2.c +++ b/src/map/lapack2flamec/f2c/c/zpstf2.c @@ -164,7 +164,7 @@ int zpstf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *piv extern doublereal dlamch_(char *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); extern integer dmaxloc_(doublereal *, integer *); extern /* Subroutine */ int zlacgv_(integer *, doublecomplex *, integer *) ; @@ -213,7 +213,7 @@ int zpstf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *piv if (*info != 0) { i__1 = -(*info); - xerbla_("ZPSTF2", &i__1); + xerbla_("ZPSTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpstrf.c b/src/map/lapack2flamec/f2c/c/zpstrf.c index c7f322f1d..fadb6a3dd 100644 --- a/src/map/lapack2flamec/f2c/c/zpstrf.c +++ b/src/map/lapack2flamec/f2c/c/zpstrf.c @@ -169,7 +169,7 @@ int zpstrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *piv int zpstf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *, doublereal *, doublereal *, integer *); extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *); @@ -221,7 +221,7 @@ int zpstrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *piv if (*info != 0) { i__1 = -(*info); - xerbla_("ZPSTRF", &i__1); + xerbla_("ZPSTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zptcon.c b/src/map/lapack2flamec/f2c/c/zptcon.c index 3715d8d30..42d277199 100644 --- a/src/map/lapack2flamec/f2c/c/zptcon.c +++ b/src/map/lapack2flamec/f2c/c/zptcon.c @@ -121,7 +121,7 @@ int zptcon_(integer *n, doublereal *d__, doublecomplex *e, doublereal *anorm, do integer i__, ix; extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -161,7 +161,7 @@ int zptcon_(integer *n, doublereal *d__, doublecomplex *e, doublereal *anorm, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTCON", &i__1); + xerbla_("ZPTCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpteqr.c b/src/map/lapack2flamec/f2c/c/zpteqr.c index c1f168ff9..7b3359cb5 100644 --- a/src/map/lapack2flamec/f2c/c/zpteqr.c +++ b/src/map/lapack2flamec/f2c/c/zpteqr.c @@ -163,7 +163,7 @@ int zpteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl integer nru; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icompz; extern /* Subroutine */ int zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *), dpttrf_(integer *, doublereal *, doublereal *, integer *), zbdsqr_(char *, integer *, integer *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *); @@ -230,7 +230,7 @@ int zpteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTEQR", &i__1); + xerbla_("ZPTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zptrfs.c b/src/map/lapack2flamec/f2c/c/zptrfs.c index d9aecc51c..059d1f93f 100644 --- a/src/map/lapack2flamec/f2c/c/zptrfs.c +++ b/src/map/lapack2flamec/f2c/c/zptrfs.c @@ -203,7 +203,7 @@ int zptrfs_(char *uplo, integer *n, integer *nrhs, doublereal *d__, doublecomple extern integer idamax_(integer *, doublereal *, integer *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zpttrs_(char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -273,7 +273,7 @@ int zptrfs_(char *uplo, integer *n, integer *nrhs, doublereal *d__, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTRFS", &i__1); + xerbla_("ZPTRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zptsv.c b/src/map/lapack2flamec/f2c/c/zptsv.c index 365ca17b1..468f035dc 100644 --- a/src/map/lapack2flamec/f2c/c/zptsv.c +++ b/src/map/lapack2flamec/f2c/c/zptsv.c @@ -110,7 +110,7 @@ int zptsv_(integer *n, integer *nrhs, doublereal *d__, doublecomplex *e, doublec integer b_dim1, b_offset, i__1; /* Local variables */ extern /* Subroutine */ - int xerbla_(char *, integer *), zpttrf_( integer *, doublereal *, doublecomplex *, integer *), zpttrs_( char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zpttrf_( integer *, doublereal *, doublecomplex *, integer *), zpttrs_( char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -149,7 +149,7 @@ int zptsv_(integer *n, integer *nrhs, doublereal *d__, doublecomplex *e, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTSV ", &i__1); + xerbla_("ZPTSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zptsvx.c b/src/map/lapack2flamec/f2c/c/zptsvx.c index 12e5a4d92..0161fad3a 100644 --- a/src/map/lapack2flamec/f2c/c/zptsvx.c +++ b/src/map/lapack2flamec/f2c/c/zptsvx.c @@ -235,7 +235,7 @@ int zptsvx_(char *fact, integer *n, integer *nrhs, doublereal *d__, doublecomple extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlanht_(char *, integer *, doublereal *, doublecomplex * ); extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zptcon_(integer *, doublereal *, doublecomplex *, doublereal *, doublereal *, doublereal *, integer *), zptrfs_(char *, integer *, integer *, doublereal *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zpttrf_(integer *, doublereal *, doublecomplex *, integer *), zpttrs_(char *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -301,7 +301,7 @@ int zptsvx_(char *fact, integer *n, integer *nrhs, doublereal *d__, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTSVX", &i__1); + xerbla_("ZPTSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpttrf.c b/src/map/lapack2flamec/f2c/c/zpttrf.c index 5e04b3d3d..1970dce70 100644 --- a/src/map/lapack2flamec/f2c/c/zpttrf.c +++ b/src/map/lapack2flamec/f2c/c/zpttrf.c @@ -94,7 +94,7 @@ int zpttrf_(integer *n, doublereal *d__, doublecomplex *e, integer *info) integer i__, i4; doublereal eii, eir; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -123,7 +123,7 @@ int zpttrf_(integer *n, doublereal *d__, doublecomplex *e, integer *info) { *info = -1; i__1 = -(*info); - xerbla_("ZPTTRF", &i__1); + xerbla_("ZPTTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zpttrs.c b/src/map/lapack2flamec/f2c/c/zpttrs.c index 2b7bbbdf2..c209b37ba 100644 --- a/src/map/lapack2flamec/f2c/c/zpttrs.c +++ b/src/map/lapack2flamec/f2c/c/zpttrs.c @@ -121,7 +121,7 @@ int zpttrs_(char *uplo, integer *n, integer *nrhs, doublereal *d__, doublecomple integer j, jb, nb, iuplo; logical upper; extern /* Subroutine */ - int zptts2_(integer *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zptts2_(integer *, integer *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -170,7 +170,7 @@ int zpttrs_(char *uplo, integer *n, integer *nrhs, doublereal *d__, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZPTTRS", &i__1); + xerbla_("ZPTTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zrot.c b/src/map/lapack2flamec/f2c/c/zrot.c index cd73b8833..4ad974150 100644 --- a/src/map/lapack2flamec/f2c/c/zrot.c +++ b/src/map/lapack2flamec/f2c/c/zrot.c @@ -103,7 +103,7 @@ int zrot_(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integ AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zrot inputs: n %" FLA_IS ", incx %" FLA_IS ", incy %" FLA_IS "",*n, *incx, *incy); extern fla_context global_context; - extern int fla_zrot_avx2(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s); + extern int fla_zrot(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s); extern int fla_zrot_native(integer *n, doublecomplex *cx, integer *incx, doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s); /* Initialize global context data */ diff --git a/src/map/lapack2flamec/f2c/c/zspcon.c b/src/map/lapack2flamec/f2c/c/zspcon.c index b94bf4901..69f380155 100644 --- a/src/map/lapack2flamec/f2c/c/zspcon.c +++ b/src/map/lapack2flamec/f2c/c/zspcon.c @@ -120,7 +120,7 @@ int zspcon_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublereal integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zsptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -167,7 +167,7 @@ int zspcon_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPCON", &i__1); + xerbla_("ZSPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zspmv.c b/src/map/lapack2flamec/f2c/c/zspmv.c index 651239529..43505f206 100644 --- a/src/map/lapack2flamec/f2c/c/zspmv.c +++ b/src/map/lapack2flamec/f2c/c/zspmv.c @@ -150,7 +150,7 @@ int zspmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doub doublecomplex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -194,7 +194,7 @@ int zspmv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doub } if (info != 0) { - xerbla_("ZSPMV ", &info); + xerbla_("ZSPMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zspr.c b/src/map/lapack2flamec/f2c/c/zspr.c index bdb645eab..73d419ebd 100644 --- a/src/map/lapack2flamec/f2c/c/zspr.c +++ b/src/map/lapack2flamec/f2c/c/zspr.c @@ -131,7 +131,7 @@ int zspr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege doublecomplex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,6 +156,7 @@ int zspr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege --x; /* Function Body */ info = 0; + kx = 0; if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { info = 1; @@ -170,7 +171,7 @@ int zspr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege } if (info != 0) { - xerbla_("ZSPR ", &info); + xerbla_("ZSPR ", &info, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsprfs.c b/src/map/lapack2flamec/f2c/c/zsprfs.c index f3ccab628..bf55f8ef3 100644 --- a/src/map/lapack2flamec/f2c/c/zsprfs.c +++ b/src/map/lapack2flamec/f2c/c/zsprfs.c @@ -201,7 +201,7 @@ int zsprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zsptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -272,7 +272,7 @@ int zsprfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPRFS", &i__1); + xerbla_("ZSPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zspsv.c b/src/map/lapack2flamec/f2c/c/zspsv.c index ec49473b4..d205cc93d 100644 --- a/src/map/lapack2flamec/f2c/c/zspsv.c +++ b/src/map/lapack2flamec/f2c/c/zspsv.c @@ -160,7 +160,7 @@ int zspsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *ip /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zsptrf_( char *, integer *, doublecomplex *, integer *, integer *), zsptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zsptrf_( char *, integer *, doublecomplex *, integer *, integer *), zsptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int zspsv_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *ip if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPSV ", &i__1); + xerbla_("ZSPSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zspsvx.c b/src/map/lapack2flamec/f2c/c/zspsvx.c index c0c553ab9..d5f3fa1d8 100644 --- a/src/map/lapack2flamec/f2c/c/zspsvx.c +++ b/src/map/lapack2flamec/f2c/c/zspsvx.c @@ -280,7 +280,7 @@ int zspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *), zlacpy_( char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacpy_( char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); extern doublereal zlansp_(char *, char *, integer *, doublecomplex *, doublereal *); extern /* Subroutine */ int zspcon_(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zsprfs_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublereal *, integer *), zsptrf_(char *, integer *, doublecomplex *, integer *, integer *), zsptrs_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); @@ -349,7 +349,7 @@ int zspsvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPSVX", &i__1); + xerbla_("ZSPSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsptrf.c b/src/map/lapack2flamec/f2c/c/zsptrf.c index 3a3798f64..7aceb5b6e 100644 --- a/src/map/lapack2flamec/f2c/c/zsptrf.c +++ b/src/map/lapack2flamec/f2c/c/zsptrf.c @@ -185,7 +185,7 @@ int zsptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -220,6 +220,7 @@ int zsptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -231,7 +232,7 @@ int zsptrf_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPTRF", &i__1); + xerbla_("ZSPTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsptri.c b/src/map/lapack2flamec/f2c/c/zsptri.c index 2b6a6c068..1f3cdfcef 100644 --- a/src/map/lapack2flamec/f2c/c/zsptri.c +++ b/src/map/lapack2flamec/f2c/c/zsptri.c @@ -134,7 +134,7 @@ int zsptri_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublecomp extern /* Double Complex */ VOID zdotu_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zspmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_( char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zspmv_(char *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer kcnext; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -175,7 +175,7 @@ int zsptri_(char *uplo, integer *n, doublecomplex *ap, integer *ipiv, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPTRI", &i__1); + xerbla_("ZSPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsptrs.c b/src/map/lapack2flamec/f2c/c/zsptrs.c index 2a2b263d9..72d5658c7 100644 --- a/src/map/lapack2flamec/f2c/c/zsptrs.c +++ b/src/map/lapack2flamec/f2c/c/zsptrs.c @@ -130,7 +130,7 @@ int zsptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *i int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -179,7 +179,7 @@ int zsptrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *ap, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZSPTRS", &i__1); + xerbla_("ZSPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zstedc.c b/src/map/lapack2flamec/f2c/c/zstedc.c index cdab2a1be..5baef1e5c 100644 --- a/src/map/lapack2flamec/f2c/c/zstedc.c +++ b/src/map/lapack2flamec/f2c/c/zstedc.c @@ -228,7 +228,7 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaed0_(integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlaset_( char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *), dstedc_(char *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, integer *), dlaset_( char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer finish; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); @@ -275,6 +275,9 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl --iwork; /* Function Body */ *info = 0; + lwmin = 0; + liwmin = 0; + lrwmin = 0; lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1; if (lsame_(compz, "N")) { @@ -365,7 +368,7 @@ int zstedc_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZSTEDC", &i__1); + xerbla_("ZSTEDC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zstein.c b/src/map/lapack2flamec/f2c/c/zstein.c index 80e82f356..c00c1c26d 100644 --- a/src/map/lapack2flamec/f2c/c/zstein.c +++ b/src/map/lapack2flamec/f2c/c/zstein.c @@ -200,7 +200,7 @@ int zstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * int dlagtf_(integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), dlagts_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlagts_( integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *); integer nrmchk; extern /* Subroutine */ int dlarnv_(integer *, integer *, integer *, doublereal *); @@ -244,6 +244,11 @@ int zstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * /* Function Body */ *info = 0; i__1 = *m; + dtpcrt = 0.; + onenrm = 0.; + ortol = 0.; + gpind = 0; + xjm = 0.; for (i__ = 1; i__ <= i__1; ++i__) @@ -288,7 +293,7 @@ int zstein_(integer *n, doublereal *d__, doublereal *e, integer *m, doublereal * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSTEIN", &i__1); + xerbla_("ZSTEIN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zstemr.c b/src/map/lapack2flamec/f2c/c/zstemr.c index 2bf8748f3..015ed46ee 100644 --- a/src/map/lapack2flamec/f2c/c/zstemr.c +++ b/src/map/lapack2flamec/f2c/c/zstemr.c @@ -384,7 +384,7 @@ int zstemr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e integer wbegin; doublereal safmin; extern /* Subroutine */ - int dlarrj_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarrj_(integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer inderr, iindwk, indgrs, offset; extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); @@ -552,7 +552,7 @@ int zstemr_(char *jobz, char *range, integer *n, doublereal * d__, doublereal *e if (*info != 0) { i__1 = -(*info); - xerbla_("ZSTEMR", &i__1); + xerbla_("ZSTEMR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsteqr.c b/src/map/lapack2flamec/f2c/c/zsteqr.c index 138f591cf..2ff17f78c 100644 --- a/src/map/lapack2flamec/f2c/c/zsteqr.c +++ b/src/map/lapack2flamec/f2c/c/zsteqr.c @@ -169,7 +169,7 @@ int zsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *); doublereal safmax; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *); extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *, integer *); @@ -240,7 +240,7 @@ int zsteqr_(char *compz, integer *n, doublereal *d__, doublereal *e, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZSTEQR", &i__1); + xerbla_("ZSTEQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsycon.c b/src/map/lapack2flamec/f2c/c/zsycon.c index 8f7743411..de969c5e7 100644 --- a/src/map/lapack2flamec/f2c/c/zsycon.c +++ b/src/map/lapack2flamec/f2c/c/zsycon.c @@ -126,7 +126,7 @@ int zsycon_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern /* Subroutine */ int zsytrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -181,7 +181,7 @@ int zsycon_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCON", &i__1); + xerbla_("ZSYCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsycon_3.c b/src/map/lapack2flamec/f2c/c/zsycon_3.c index c4aaecd95..109299987 100644 --- a/src/map/lapack2flamec/f2c/c/zsycon_3.c +++ b/src/map/lapack2flamec/f2c/c/zsycon_3.c @@ -169,7 +169,7 @@ int zsycon_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -223,7 +223,7 @@ int zsycon_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCON_3", &i__1); + xerbla_("ZSYCON_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsycon_rook.c b/src/map/lapack2flamec/f2c/c/zsycon_rook.c index c2553f424..3a9d81456 100644 --- a/src/map/lapack2flamec/f2c/c/zsycon_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsycon_rook.c @@ -140,7 +140,7 @@ int zsycon_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer integer isave[3]; logical upper; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -193,7 +193,7 @@ int zsycon_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCON_ROOK", &i__1); + xerbla_("ZSYCON_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyconv.c b/src/map/lapack2flamec/f2c/c/zsyconv.c index 2ce09c950..3f0e4b99d 100644 --- a/src/map/lapack2flamec/f2c/c/zsyconv.c +++ b/src/map/lapack2flamec/f2c/c/zsyconv.c @@ -114,7 +114,7 @@ int zsyconv_(char *uplo, char *way, integer *n, doublecomplex *a, integer *lda, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -161,7 +161,7 @@ int zsyconv_(char *uplo, char *way, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCONV", &i__1); + xerbla_("ZSYCONV", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyconvf.c b/src/map/lapack2flamec/f2c/c/zsyconvf.c index 9bd1c5966..98b3cb923 100644 --- a/src/map/lapack2flamec/f2c/c/zsyconvf.c +++ b/src/map/lapack2flamec/f2c/c/zsyconvf.c @@ -211,7 +211,7 @@ int zsyconvf_(char *uplo, char *way, integer *n, doublecomplex *a, integer *lda, extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -258,7 +258,7 @@ int zsyconvf_(char *uplo, char *way, integer *n, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCONVF", &i__1); + xerbla_("ZSYCONVF", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyconvf_rook.c b/src/map/lapack2flamec/f2c/c/zsyconvf_rook.c index 1d2221e92..82fc5f414 100644 --- a/src/map/lapack2flamec/f2c/c/zsyconvf_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsyconvf_rook.c @@ -202,7 +202,7 @@ int zsyconvf_rook_(char *uplo, char *way, integer *n, doublecomplex *a, integer extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical convert; /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -249,7 +249,7 @@ int zsyconvf_rook_(char *uplo, char *way, integer *n, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYCONVF_ROOK", &i__1); + xerbla_("ZSYCONVF_ROOK", &i__1, (ftnlen)13); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyequb.c b/src/map/lapack2flamec/f2c/c/zsyequb.c index 8d5ac7f99..29e10cb23 100644 --- a/src/map/lapack2flamec/f2c/c/zsyequb.c +++ b/src/map/lapack2flamec/f2c/c/zsyequb.c @@ -142,7 +142,7 @@ int zsyequb_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal doublereal sumsq; extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum, smlnum; extern /* Subroutine */ int zlassq_(integer *, doublecomplex *, integer *, doublereal *, doublereal *); @@ -193,7 +193,7 @@ int zsyequb_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYEQUB", &i__1); + xerbla_("ZSYEQUB", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsymv.c b/src/map/lapack2flamec/f2c/c/zsymv.c index d5bc2e6ea..38059f299 100644 --- a/src/map/lapack2flamec/f2c/c/zsymv.c +++ b/src/map/lapack2flamec/f2c/c/zsymv.c @@ -156,7 +156,7 @@ int zsymv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *a, integ doublecomplex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -208,7 +208,7 @@ int zsymv_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *a, integ } if (info != 0) { - xerbla_("ZSYMV ", &info); + xerbla_("ZSYMV ", &info, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyr.c b/src/map/lapack2flamec/f2c/c/zsyr.c index e2ca0d40c..61f5760da 100644 --- a/src/map/lapack2flamec/f2c/c/zsyr.c +++ b/src/map/lapack2flamec/f2c/c/zsyr.c @@ -134,7 +134,7 @@ int zsyr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege doublecomplex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK auxiliary routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -163,6 +163,7 @@ int zsyr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege a -= a_offset; /* Function Body */ info = 0; + kx = 0; if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { info = 1; @@ -181,7 +182,7 @@ int zsyr_(char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, intege } if (info != 0) { - xerbla_("ZSYR ", &info); + xerbla_("ZSYR ", &info, (ftnlen)5); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyrfs.c b/src/map/lapack2flamec/f2c/c/zsyrfs.c index d7f46c917..ab68a43a1 100644 --- a/src/map/lapack2flamec/f2c/c/zsyrfs.c +++ b/src/map/lapack2flamec/f2c/c/zsyrfs.c @@ -210,7 +210,7 @@ int zsyrfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal lstres; extern /* Subroutine */ int zsytrs_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); @@ -293,7 +293,7 @@ int zsyrfs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYRFS", &i__1); + xerbla_("ZSYRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsyrfsx.c b/src/map/lapack2flamec/f2c/c/zsyrfsx.c index 16cc43dc7..c9f79672a 100644 --- a/src/map/lapack2flamec/f2c/c/zsyrfsx.c +++ b/src/map/lapack2flamec/f2c/c/zsyrfsx.c @@ -420,7 +420,7 @@ int zsyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex logical rcequ; extern doublereal zla_syrcond_c_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *, logical *, integer *, doublecomplex *, doublereal *), zla_syrcond_x_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *), dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlansy_(char *, char *, integer *, doublecomplex *, integer *, doublereal *); extern /* Subroutine */ int zsycon_(char *, integer *, doublecomplex *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *); @@ -571,7 +571,7 @@ int zsyrfsx_(char *uplo, char *equed, integer *n, integer * nrhs, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYRFSX", &i__1); + xerbla_("ZSYRFSX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysv.c b/src/map/lapack2flamec/f2c/c/zsysv.c index 4271bce9c..2a161c7b9 100644 --- a/src/map/lapack2flamec/f2c/c/zsysv.c +++ b/src/map/lapack2flamec/f2c/c/zsysv.c @@ -170,7 +170,7 @@ int zsysv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -247,7 +247,7 @@ int zsysv_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSV ", &i__1); + xerbla_("ZSYSV ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysv_aa.c b/src/map/lapack2flamec/f2c/c/zsysv_aa.c index 7ffc1139b..96b21e90f 100644 --- a/src/map/lapack2flamec/f2c/c/zsysv_aa.c +++ b/src/map/lapack2flamec/f2c/c/zsysv_aa.c @@ -163,7 +163,7 @@ int zsysv_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * extern logical lsame_(char *, char *); integer lwkopt_sytrf__, lwkopt_sytrs__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.8.0) -- */ @@ -240,7 +240,7 @@ int zsysv_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSV_AA ", &i__1); + xerbla_("ZSYSV_AA ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysv_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zsysv_aa_2stage.c index b3409fb02..ada083267 100644 --- a/src/map/lapack2flamec/f2c/c/zsysv_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zsysv_aa_2stage.c @@ -188,7 +188,7 @@ int zsysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, in extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical tquery, wquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -262,7 +262,7 @@ int zsysv_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSV_AA_2STAGE", &i__1); + xerbla_("ZSYSV_AA_2STAGE", &i__1, (ftnlen)15); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysv_rk.c b/src/map/lapack2flamec/f2c/c/zsysv_rk.c index 0b73ac241..aff9d3b97 100644 --- a/src/map/lapack2flamec/f2c/c/zsysv_rk.c +++ b/src/map/lapack2flamec/f2c/c/zsysv_rk.c @@ -229,7 +229,7 @@ int zsysv_rk_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * int zsytrs_3_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zsytrf_rk_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.7.0) -- */ @@ -305,7 +305,7 @@ int zsysv_rk_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSV_RK ", &i__1); + xerbla_("ZSYSV_RK ", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysv_rook.c b/src/map/lapack2flamec/f2c/c/zsysv_rook.c index 2090e588e..185a51b93 100644 --- a/src/map/lapack2flamec/f2c/c/zsysv_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsysv_rook.c @@ -203,7 +203,7 @@ int zsysv_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer int zsytrf_rook_(char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zsytrs_rook_(char *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; /* -- LAPACK driver routine (version 3.4.0) -- */ @@ -278,7 +278,7 @@ int zsysv_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSV_ROOK ", &i__1); + xerbla_("ZSYSV_ROOK ", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysvx.c b/src/map/lapack2flamec/f2c/c/zsysvx.c index e1a1f9367..5058e2405 100644 --- a/src/map/lapack2flamec/f2c/c/zsysvx.c +++ b/src/map/lapack2flamec/f2c/c/zsysvx.c @@ -287,7 +287,7 @@ int zsysvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -401,7 +401,7 @@ int zsysvx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex *a if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSVX", &i__1); + xerbla_("ZSYSVX", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsysvxx.c b/src/map/lapack2flamec/f2c/c/zsysvxx.c index 500926dcf..1a9c7c0b4 100644 --- a/src/map/lapack2flamec/f2c/c/zsysvxx.c +++ b/src/map/lapack2flamec/f2c/c/zsysvxx.c @@ -519,7 +519,7 @@ int zsysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * extern doublereal dlamch_(char *); logical nofact; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; integer infequ; extern /* Subroutine */ @@ -669,7 +669,7 @@ int zsysvxx_(char *fact, char *uplo, integer *n, integer * nrhs, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYSVXX", &i__1); + xerbla_("ZSYSVXX", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytf2.c b/src/map/lapack2flamec/f2c/c/zsytf2.c index 7b32fee38..609ffeaf7 100644 --- a/src/map/lapack2flamec/f2c/c/zsytf2.c +++ b/src/map/lapack2flamec/f2c/c/zsytf2.c @@ -213,7 +213,7 @@ int zsytf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi doublereal absakk; extern logical disnan_(doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -250,6 +250,7 @@ int zsytf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -265,7 +266,7 @@ int zsytf2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTF2", &i__1); + xerbla_("ZSYTF2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytf2_rk.c b/src/map/lapack2flamec/f2c/c/zsytf2_rk.c index 52eac0c43..df5e51544 100644 --- a/src/map/lapack2flamec/f2c/c/zsytf2_rk.c +++ b/src/map/lapack2flamec/f2c/c/zsytf2_rk.c @@ -267,7 +267,7 @@ int zsytf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom extern doublereal dlamch_(char *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -305,6 +305,8 @@ int zsytf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -320,7 +322,7 @@ int zsytf2_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTF2_RK", &i__1); + xerbla_("ZSYTF2_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytf2_rook.c b/src/map/lapack2flamec/f2c/c/zsytf2_rook.c index 8fdf89db9..1989a190b 100644 --- a/src/map/lapack2flamec/f2c/c/zsytf2_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsytf2_rook.c @@ -217,7 +217,7 @@ int zsytf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer extern doublereal dlamch_(char *); doublereal absakk; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal colmax; extern integer izamax_(integer *, doublecomplex *, integer *); doublereal rowmax; @@ -254,6 +254,8 @@ int zsytf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer /* Function Body */ *info = 0; upper = lsame_(uplo, "U"); + jmax = 0; + imax = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -269,7 +271,7 @@ int zsytf2_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTF2_ROOK", &i__1); + xerbla_("ZSYTF2_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrf.c b/src/map/lapack2flamec/f2c/c/zsytrf.c index 8161fb6d9..91897f5f4 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrf.c +++ b/src/map/lapack2flamec/f2c/c/zsytrf.c @@ -186,7 +186,7 @@ int zsytrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zsytf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int zsytf2_(char *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork; extern /* Subroutine */ @@ -249,7 +249,7 @@ int zsytrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRF", &i__1); + xerbla_("ZSYTRF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrf_aa.c b/src/map/lapack2flamec/f2c/c/zsytrf_aa.c index 40850c22b..6d78c52f9 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrf_aa.c +++ b/src/map/lapack2flamec/f2c/c/zsytrf_aa.c @@ -151,7 +151,7 @@ int zsytrf_aa_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer * int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -218,7 +218,7 @@ int zsytrf_aa_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRF_AA", &i__1); + xerbla_("ZSYTRF_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrf_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zsytrf_aa_2stage.c index e459afa2d..16c410497 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrf_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zsytrf_aa_2stage.c @@ -179,7 +179,7 @@ int zsytrf_aa_2stage_(char *uplo, integer *n, doublecomplex *a, integer *lda, do int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zgbtrf_(integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, integer *), zgetrf_(integer *, integer *, doublecomplex *, integer *, integer *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); @@ -240,7 +240,7 @@ int zsytrf_aa_2stage_(char *uplo, integer *n, doublecomplex *a, integer *lda, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRF_AA_2STAGE", &i__1); + xerbla_("ZSYTRF_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrf_rk.c b/src/map/lapack2flamec/f2c/c/zsytrf_rk.c index be0e9e3d7..fb752f095 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrf_rk.c +++ b/src/map/lapack2flamec/f2c/c/zsytrf_rk.c @@ -265,7 +265,7 @@ int zsytrf_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -326,7 +326,7 @@ int zsytrf_rk_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRF_RK", &i__1); + xerbla_("ZSYTRF_RK", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrf_rook.c b/src/map/lapack2flamec/f2c/c/zsytrf_rook.c index bd6ad7feb..79591b6aa 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrf_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsytrf_rook.c @@ -212,7 +212,7 @@ int zsytrf_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -275,7 +275,7 @@ int zsytrf_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRF_ROOK", &i__1); + xerbla_("ZSYTRF_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri.c b/src/map/lapack2flamec/f2c/c/zsytri.c index 4d26c0ef5..a7eacc724 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri.c +++ b/src/map/lapack2flamec/f2c/c/zsytri.c @@ -138,7 +138,7 @@ int zsytri_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi extern /* Double Complex */ VOID zdotu_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zsymv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zsymv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -184,7 +184,7 @@ int zsytri_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ipi if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI", &i__1); + xerbla_("ZSYTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri2.c b/src/map/lapack2flamec/f2c/c/zsytri2.c index 1085fa112..51ed32315 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri2.c +++ b/src/map/lapack2flamec/f2c/c/zsytri2.c @@ -133,7 +133,7 @@ int zsytri2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ip integer nbmax; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical lquery; extern /* Subroutine */ @@ -196,7 +196,7 @@ int zsytri2_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *ip if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI2", &i__1); + xerbla_("ZSYTRI2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri2x.c b/src/map/lapack2flamec/f2c/c/zsytri2x.c index e8ad3269e..862fcfb04 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri2x.c +++ b/src/map/lapack2flamec/f2c/c/zsytri2x.c @@ -149,7 +149,7 @@ int zsytri2x_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *i int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); doublecomplex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *), ztrtri_( char *, char *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ztrtri_( char *, char *, integer *, doublecomplex *, integer *, integer *); doublecomplex u01_ip1_j__, u11_ip1_j__; extern /* Subroutine */ int zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); @@ -201,7 +201,7 @@ int zsytri2x_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI2X", &i__1); + xerbla_("ZSYTRI2X", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri_3.c b/src/map/lapack2flamec/f2c/c/zsytri_3.c index c33415a67..86841210d 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri_3.c +++ b/src/map/lapack2flamec/f2c/c/zsytri_3.c @@ -176,7 +176,7 @@ int zsytri_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -235,7 +235,7 @@ int zsytri_3_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI_3", &i__1); + xerbla_("ZSYTRI_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri_3x.c b/src/map/lapack2flamec/f2c/c/zsytri_3x.c index 87960cb8c..4ab5bdbd1 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri_3x.c +++ b/src/map/lapack2flamec/f2c/c/zsytri_3x.c @@ -187,7 +187,7 @@ int zsytri_3x_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); doublecomplex u01_i_j__, u11_i_j__; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer icount; extern /* Subroutine */ int ztrtri_(char *, char *, integer *, doublecomplex *, integer *, integer *); @@ -241,7 +241,7 @@ int zsytri_3x_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI_3X", &i__1); + xerbla_("ZSYTRI_3X", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytri_rook.c b/src/map/lapack2flamec/f2c/c/zsytri_rook.c index d165b2821..25aff62ca 100644 --- a/src/map/lapack2flamec/f2c/c/zsytri_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsytri_rook.c @@ -152,7 +152,7 @@ int zsytri_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer extern /* Double Complex */ VOID zdotu_f2c_(doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zsymv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zsymv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -198,7 +198,7 @@ int zsytri_rook_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRI_ROOK", &i__1); + xerbla_("ZSYTRI_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs.c b/src/map/lapack2flamec/f2c/c/zsytrs.c index f4c862a7f..a737a2f28 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs.c @@ -134,7 +134,7 @@ int zsytrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -189,7 +189,7 @@ int zsytrs_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS", &i__1); + xerbla_("ZSYTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs2.c b/src/map/lapack2flamec/f2c/c/zsytrs2.c index c0b90fcd0..880b3af79 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs2.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs2.c @@ -145,7 +145,7 @@ int zsytrs2_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *l int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zsyconv_(char *, char *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -201,7 +201,7 @@ int zsytrs2_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS2", &i__1); + xerbla_("ZSYTRS2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs_3.c b/src/map/lapack2flamec/f2c/c/zsytrs_3.c index 9a5459ad6..3b317d224 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs_3.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs_3.c @@ -178,7 +178,7 @@ int zsytrs_3_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -234,7 +234,7 @@ int zsytrs_3_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS_3", &i__1); + xerbla_("ZSYTRS_3", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs_aa.c b/src/map/lapack2flamec/f2c/c/zsytrs_aa.c index be246e8b6..6cc4e8277 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs_aa.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs_aa.c @@ -135,7 +135,7 @@ int zsytrs_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgtsv_(integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + int zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgtsv_(integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); integer lwkopt; logical lquery; /* -- LAPACK computational routine (version 3.8.0) -- */ @@ -203,7 +203,7 @@ int zsytrs_aa_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS_AA", &i__1); + xerbla_("ZSYTRS_AA", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs_aa_2stage.c b/src/map/lapack2flamec/f2c/c/zsytrs_aa_2stage.c index e944d974f..7dcd46655 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs_aa_2stage.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs_aa_2stage.c @@ -145,7 +145,7 @@ int zsytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, i extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zgbtrs_(char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, integer *, doublecomplex *, integer *, integer *), zlaswp_(integer *, doublecomplex *, integer *, integer *, integer *, integer *, integer *); /* -- LAPACK computational routine (version 3.8.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -205,7 +205,7 @@ int zsytrs_aa_2stage_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS_AA_2STAGE", &i__1); + xerbla_("ZSYTRS_AA_2STAGE", &i__1, (ftnlen)16); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zsytrs_rook.c b/src/map/lapack2flamec/f2c/c/zsytrs_rook.c index a4317d4de..98aac3149 100644 --- a/src/map/lapack2flamec/f2c/c/zsytrs_rook.c +++ b/src/map/lapack2flamec/f2c/c/zsytrs_rook.c @@ -148,7 +148,7 @@ int zsytrs_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, intege int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -203,7 +203,7 @@ int zsytrs_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZSYTRS_ROOK", &i__1); + xerbla_("ZSYTRS_ROOK", &i__1, (ftnlen)11); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztbcon.c b/src/map/lapack2flamec/f2c/c/ztbcon.c index 0b65af2d8..cb77ca812 100644 --- a/src/map/lapack2flamec/f2c/c/ztbcon.c +++ b/src/map/lapack2flamec/f2c/c/ztbcon.c @@ -155,7 +155,7 @@ int ztbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, doublec int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); extern doublereal zlantb_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublereal *); @@ -230,7 +230,7 @@ int ztbcon_(char *norm, char *uplo, char *diag, integer *n, integer *kd, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZTBCON", &i__1); + xerbla_("ZTBCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztbrfs.c b/src/map/lapack2flamec/f2c/c/ztbrfs.c index add163c04..e5030dd07 100644 --- a/src/map/lapack2flamec/f2c/c/ztbrfs.c +++ b/src/map/lapack2flamec/f2c/c/ztbrfs.c @@ -203,7 +203,7 @@ int ztbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -293,7 +293,7 @@ int ztbrfs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZTBRFS", &i__1); + xerbla_("ZTBRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztbtrs.c b/src/map/lapack2flamec/f2c/c/ztbtrs.c index e5429287c..067a1460b 100644 --- a/src/map/lapack2flamec/f2c/c/ztbtrs.c +++ b/src/map/lapack2flamec/f2c/c/ztbtrs.c @@ -147,7 +147,7 @@ int ztbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztbsv_(char *, char *, char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -216,7 +216,7 @@ int ztbtrs_(char *uplo, char *trans, char *diag, integer *n, integer *kd, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZTBTRS", &i__1); + xerbla_("ZTBTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztfsm.c b/src/map/lapack2flamec/f2c/c/ztfsm.c index 510068953..b408d662e 100644 --- a/src/map/lapack2flamec/f2c/c/ztfsm.c +++ b/src/map/lapack2flamec/f2c/c/ztfsm.c @@ -307,7 +307,7 @@ int ztfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical lower; extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical misodd, nisodd, notrans; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -376,7 +376,7 @@ int ztfsm_(char *transr, char *side, char *uplo, char *trans, char *diag, intege if (info != 0) { i__1 = -info; - xerbla_("ZTFSM ", &i__1); + xerbla_("ZTFSM ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztftri.c b/src/map/lapack2flamec/f2c/c/ztftri.c index 55dcc5bf3..ff88148f6 100644 --- a/src/map/lapack2flamec/f2c/c/ztftri.c +++ b/src/map/lapack2flamec/f2c/c/ztftri.c @@ -233,7 +233,7 @@ int ztftri_(char *transr, char *uplo, char *diag, integer *n, doublecomplex *a, extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; extern /* Subroutine */ int ztrtri_(char *, char *, integer *, doublecomplex *, integer *, integer *); @@ -280,7 +280,7 @@ int ztftri_(char *transr, char *uplo, char *diag, integer *n, doublecomplex *a, if (*info != 0) { i__1 = -(*info); - xerbla_("ZTFTRI", &i__1); + xerbla_("ZTFTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztfttp.c b/src/map/lapack2flamec/f2c/c/ztfttp.c index 5695fa9cf..fee452454 100644 --- a/src/map/lapack2flamec/f2c/c/ztfttp.c +++ b/src/map/lapack2flamec/f2c/c/ztfttp.c @@ -208,12 +208,12 @@ int ztfttp_(char *transr, char *uplo, integer *n, doublecomplex *arf, doublecomp /* Builtin functions */ void d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -256,7 +256,7 @@ int ztfttp_(char *transr, char *uplo, integer *n, doublecomplex *arf, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZTFTTP", &i__1); + xerbla_("ZTFTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -283,7 +283,6 @@ int ztfttp_(char *transr, char *uplo, integer *n, doublecomplex *arf, doublecomp return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/ztfttr.c b/src/map/lapack2flamec/f2c/c/ztfttr.c index b88d5b7a5..6c1a8935c 100644 --- a/src/map/lapack2flamec/f2c/c/ztfttr.c +++ b/src/map/lapack2flamec/f2c/c/ztfttr.c @@ -220,7 +220,7 @@ int ztfttr_(char *transr, char *uplo, integer *n, doublecomplex *arf, doublecomp extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -270,7 +270,7 @@ int ztfttr_(char *transr, char *uplo, integer *n, doublecomplex *arf, doublecomp if (*info != 0) { i__1 = -(*info); - xerbla_("ZTFTTR", &i__1); + xerbla_("ZTFTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgevc.c b/src/map/lapack2flamec/f2c/c/ztgevc.c index 0137a4d14..4822c44d2 100644 --- a/src/map/lapack2flamec/f2c/c/ztgevc.c +++ b/src/map/lapack2flamec/f2c/c/ztgevc.c @@ -268,11 +268,11 @@ int ztgevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex doublecomplex salpha; doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical ilcomp; extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); integer ihwmny; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -316,6 +316,8 @@ int ztgevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex --work; --rwork; /* Function Body */ + ilall = FALSE_; + ilback = FALSE_; if (lsame_(howmny, "A")) { ihwmny = 1; @@ -384,7 +386,7 @@ int ztgevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGEVC", &i__1); + xerbla_("ZTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -440,7 +442,7 @@ int ztgevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGEVC", &i__1); + xerbla_("ZTGEVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgexc.c b/src/map/lapack2flamec/f2c/c/ztgexc.c index 6f9187fb8..dda2a0961 100644 --- a/src/map/lapack2flamec/f2c/c/ztgexc.c +++ b/src/map/lapack2flamec/f2c/c/ztgexc.c @@ -200,7 +200,7 @@ int ztgexc_(logical *wantq, logical *wantz, integer *n, doublecomplex *a, intege /* Local variables */ integer here; extern /* Subroutine */ - int ztgex2_(logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(char *, integer *); + int ztgex2_(logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -264,7 +264,7 @@ int ztgexc_(logical *wantq, logical *wantz, integer *n, doublecomplex *a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGEXC", &i__1); + xerbla_("ZTGEXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgsen.c b/src/map/lapack2flamec/f2c/c/ztgsen.c index 707767a56..3769535e5 100644 --- a/src/map/lapack2flamec/f2c/c/ztgsen.c +++ b/src/map/lapack2flamec/f2c/c/ztgsen.c @@ -455,7 +455,7 @@ int ztgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte extern doublereal dlamch_(char *); doublereal dscale, rdscal, safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer liwmin; extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztgexc_(logical *, logical *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, integer *), zlassq_(integer *, doublecomplex *, integer *, doublereal *, doublereal *); @@ -534,7 +534,7 @@ int ztgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSEN", &i__1); + xerbla_("ZTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -620,7 +620,7 @@ int ztgsen_(integer *ijob, logical *wantq, logical *wantz, logical *select, inte if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSEN", &i__1); + xerbla_("ZTGSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgsja.c b/src/map/lapack2flamec/f2c/c/ztgsja.c index 9c0f26400..a214cdde1 100644 --- a/src/map/lapack2flamec/f2c/c/ztgsja.c +++ b/src/map/lapack2flamec/f2c/c/ztgsja.c @@ -420,7 +420,7 @@ int ztgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zlags2_(logical *, doublereal *, doublecomplex *, doublereal *, doublereal *, doublecomplex *, doublereal *, doublereal *, doublecomplex *, doublereal *, doublecomplex *, doublereal *, doublecomplex *); integer kcycle; extern /* Subroutine */ - int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlapll_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); + int dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlapll_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); doublereal hugenum; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -517,7 +517,7 @@ int ztgsja_(char *jobu, char *jobv, char *jobq, integer *m, integer *p, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSJA", &i__1); + xerbla_("ZTGSJA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgsna.c b/src/map/lapack2flamec/f2c/c/ztgsna.c index b95edc5a3..334ea2bab 100644 --- a/src/map/lapack2flamec/f2c/c/ztgsna.c +++ b/src/map/lapack2flamec/f2c/c/ztgsna.c @@ -349,7 +349,7 @@ int ztgsna_(char *job, char *howmny, logical *select, integer *n, doublecomplex doublecomplex dummy1[1]; extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_( char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical wantbh, wantdf, somcon; extern /* Subroutine */ @@ -483,7 +483,7 @@ int ztgsna_(char *job, char *howmny, logical *select, integer *n, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSNA", &i__1); + xerbla_("ZTGSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgsy2.c b/src/map/lapack2flamec/f2c/c/ztgsy2.c index c6b683197..bb06cc51b 100644 --- a/src/map/lapack2flamec/f2c/c/ztgsy2.c +++ b/src/map/lapack2flamec/f2c/c/ztgsy2.c @@ -265,7 +265,7 @@ int ztgsy2_(char *trans, integer *ijob, integer *m, integer * n, doublecomplex * int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zgesc2_( integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, doublereal *), zgetc2_(integer *, doublecomplex *, integer *, integer *, integer *, integer *); doublereal scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *), zlatdf_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *, doublereal *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlatdf_( integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublereal *, doublereal *, integer *, integer *); logical notran; /* -- LAPACK auxiliary routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -362,7 +362,7 @@ int ztgsy2_(char *trans, integer *ijob, integer *m, integer * n, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSY2", &i__1); + xerbla_("ZTGSY2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztgsyl.c b/src/map/lapack2flamec/f2c/c/ztgsyl.c index 6fa5f8171..1c65c03d5 100644 --- a/src/map/lapack2flamec/f2c/c/ztgsyl.c +++ b/src/map/lapack2flamec/f2c/c/ztgsyl.c @@ -321,7 +321,7 @@ int ztgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublecomplex * int ztgsy2_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, integer *); doublereal scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer iround; logical notran; @@ -377,6 +377,7 @@ int ztgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublecomplex * *info = 0; notran = lsame_(trans, "N"); lquery = *lwork == -1; + scale2 = 0.; if (! notran && ! lsame_(trans, "C")) { *info = -1; @@ -453,7 +454,7 @@ int ztgsyl_(char *trans, integer *ijob, integer *m, integer * n, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZTGSYL", &i__1); + xerbla_("ZTGSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpcon.c b/src/map/lapack2flamec/f2c/c/ztpcon.c index afac967d9..516f7686a 100644 --- a/src/map/lapack2flamec/f2c/c/ztpcon.c +++ b/src/map/lapack2flamec/f2c/c/ztpcon.c @@ -142,7 +142,7 @@ int ztpcon_(char *norm, char *uplo, char *diag, integer *n, doublecomplex *ap, d int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); logical onenrm; @@ -209,7 +209,7 @@ int ztpcon_(char *norm, char *uplo, char *diag, integer *n, doublecomplex *ap, d if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPCON", &i__1); + xerbla_("ZTPCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztplqt.c b/src/map/lapack2flamec/f2c/c/ztplqt.c index 886ea4abe..0b7609d16 100644 --- a/src/map/lapack2flamec/f2c/c/ztplqt.c +++ b/src/map/lapack2flamec/f2c/c/ztplqt.c @@ -185,7 +185,7 @@ int ztplqt_(integer *m, integer *n, integer *l, integer *mb, doublecomplex *a, i /* Local variables */ integer i__, ib, lb, nb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), ztprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztplqt2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ztprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztplqt2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -246,7 +246,7 @@ int ztplqt_(integer *m, integer *n, integer *l, integer *mb, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPLQT", &i__1); + xerbla_("ZTPLQT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztplqt2.c b/src/map/lapack2flamec/f2c/c/ztplqt2.c index 018281842..514ff84b8 100644 --- a/src/map/lapack2flamec/f2c/c/ztplqt2.c +++ b/src/map/lapack2flamec/f2c/c/ztplqt2.c @@ -189,7 +189,7 @@ int ztplqt2_(integer *m, integer *n, integer *l, doublecomplex *a, integer *lda, integer i__, j, p, mp, np; doublecomplex alpha; extern /* Subroutine */ - int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.7.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -248,7 +248,7 @@ int ztplqt2_(integer *m, integer *n, integer *l, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPLQT2", &i__1); + xerbla_("ZTPLQT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpmlqt.c b/src/map/lapack2flamec/f2c/c/ztpmlqt.c index 05d642ea8..d4a7b8abc 100644 --- a/src/map/lapack2flamec/f2c/c/ztpmlqt.c +++ b/src/map/lapack2flamec/f2c/c/ztpmlqt.c @@ -220,7 +220,7 @@ int ztpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int ztprfb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -319,7 +319,7 @@ int ztpmlqt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPMLQT", &i__1); + xerbla_("ZTPMLQT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpmqrt.c b/src/map/lapack2flamec/f2c/c/ztpmqrt.c index ff06ef4d1..3ca17a421 100644 --- a/src/map/lapack2flamec/f2c/c/ztpmqrt.c +++ b/src/map/lapack2flamec/f2c/c/ztpmqrt.c @@ -221,7 +221,7 @@ int ztpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege extern logical lsame_(char *, char *); logical right; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; extern /* Subroutine */ int ztprfb_(char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -322,7 +322,7 @@ int ztpmqrt_(char *side, char *trans, integer *m, integer *n, integer *k, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPMQRT", &i__1); + xerbla_("ZTPMQRT", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpqrt.c b/src/map/lapack2flamec/f2c/c/ztpqrt.c index 5d535d96b..85ca3344b 100644 --- a/src/map/lapack2flamec/f2c/c/ztpqrt.c +++ b/src/map/lapack2flamec/f2c/c/ztpqrt.c @@ -185,7 +185,7 @@ int ztpqrt_(integer *m, integer *n, integer *l, integer *nb, doublecomplex *a, i /* Local variables */ integer i__, ib, lb, mb, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *), ztprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztpqrt2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), ztprfb_( char *, char *, char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztpqrt2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -246,7 +246,7 @@ int ztpqrt_(integer *m, integer *n, integer *l, integer *nb, doublecomplex *a, i if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPQRT", &i__1); + xerbla_("ZTPQRT", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpqrt2.c b/src/map/lapack2flamec/f2c/c/ztpqrt2.c index e49e423f6..933e647b7 100644 --- a/src/map/lapack2flamec/f2c/c/ztpqrt2.c +++ b/src/map/lapack2flamec/f2c/c/ztpqrt2.c @@ -186,7 +186,7 @@ int ztpqrt2_(integer *m, integer *n, integer *l, doublecomplex *a, integer *lda, integer i__, j, p, mp, np; doublecomplex alpha; extern /* Subroutine */ - int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -245,7 +245,7 @@ int ztpqrt2_(integer *m, integer *n, integer *l, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPQRT2", &i__1); + xerbla_("ZTPQRT2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztprfs.c b/src/map/lapack2flamec/f2c/c/ztprfs.c index f8afff80e..b745a52ea 100644 --- a/src/map/lapack2flamec/f2c/c/ztprfs.c +++ b/src/map/lapack2flamec/f2c/c/ztprfs.c @@ -191,7 +191,7 @@ int ztprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -271,7 +271,7 @@ int ztprfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPRFS", &i__1); + xerbla_("ZTPRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztptri.c b/src/map/lapack2flamec/f2c/c/ztptri.c index 37540e106..68e37563e 100644 --- a/src/map/lapack2flamec/f2c/c/ztptri.c +++ b/src/map/lapack2flamec/f2c/c/ztptri.c @@ -130,7 +130,7 @@ int ztptri_(char *uplo, char *diag, integer *n, doublecomplex *ap, integer *info int zscal_(integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztpmv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jclast; logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -158,6 +158,7 @@ int ztptri_(char *uplo, char *diag, integer *n, doublecomplex *ap, integer *info *info = 0; upper = lsame_(uplo, "U"); nounit = lsame_(diag, "N"); + jclast = 0; if (! upper && ! lsame_(uplo, "L")) { *info = -1; @@ -173,7 +174,7 @@ int ztptri_(char *uplo, char *diag, integer *n, doublecomplex *ap, integer *info if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPTRI", &i__1); + xerbla_("ZTPTRI", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztptrs.c b/src/map/lapack2flamec/f2c/c/ztptrs.c index 61e32dec4..af86fb895 100644 --- a/src/map/lapack2flamec/f2c/c/ztptrs.c +++ b/src/map/lapack2flamec/f2c/c/ztptrs.c @@ -132,7 +132,7 @@ int ztptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztpsv_(char *, char *, char *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -191,7 +191,7 @@ int ztptrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPTRS", &i__1); + xerbla_("ZTPTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztpttf.c b/src/map/lapack2flamec/f2c/c/ztpttf.c index 44a1bfe75..ea937d214 100644 --- a/src/map/lapack2flamec/f2c/c/ztpttf.c +++ b/src/map/lapack2flamec/f2c/c/ztpttf.c @@ -206,12 +206,12 @@ int ztpttf_(char *transr, char *uplo, integer *n, doublecomplex *ap, doublecompl /* Builtin functions */ void d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ - integer i__, j, k, n1, n2, ij, jp, js, nt, lda, ijp; + integer i__, j, k, n1, n2, ij, jp, js, lda, ijp; logical normaltransr; extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -251,7 +251,7 @@ int ztpttf_(char *transr, char *uplo, integer *n, doublecomplex *ap, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPTTF", &i__1); + xerbla_("ZTPTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -278,7 +278,6 @@ int ztpttf_(char *transr, char *uplo, integer *n, doublecomplex *ap, doublecompl return 0; } /* Size of array ARF(0:NT-1) */ - nt = *n * (*n + 1) / 2; /* Set N1 and N2 depending on LOWER */ if (lower) { diff --git a/src/map/lapack2flamec/f2c/c/ztpttr.c b/src/map/lapack2flamec/f2c/c/ztpttr.c index a3d5c613a..863ceb896 100644 --- a/src/map/lapack2flamec/f2c/c/ztpttr.c +++ b/src/map/lapack2flamec/f2c/c/ztpttr.c @@ -102,7 +102,7 @@ int ztpttr_(char *uplo, integer *n, doublecomplex *ap, doublecomplex *a, integer extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -145,7 +145,7 @@ int ztpttr_(char *uplo, integer *n, doublecomplex *ap, doublecomplex *a, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZTPTTR", &i__1); + xerbla_("ZTPTTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrcon.c b/src/map/lapack2flamec/f2c/c/ztrcon.c index d1903863d..90a68e13a 100644 --- a/src/map/lapack2flamec/f2c/c/ztrcon.c +++ b/src/map/lapack2flamec/f2c/c/ztrcon.c @@ -148,7 +148,7 @@ int ztrcon_(char *norm, char *uplo, char *diag, integer *n, doublecomplex *a, in int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal ainvnm; extern integer izamax_(integer *, doublecomplex *, integer *); logical onenrm; @@ -221,7 +221,7 @@ int ztrcon_(char *norm, char *uplo, char *diag, integer *n, doublecomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRCON", &i__1); + xerbla_("ZTRCON", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrevc.c b/src/map/lapack2flamec/f2c/c/ztrevc.c index 806fd20ff..2bcb346fc 100644 --- a/src/map/lapack2flamec/f2c/c/ztrevc.c +++ b/src/map/lapack2flamec/f2c/c/ztrevc.c @@ -248,7 +248,7 @@ int ztrevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zdscal_( integer *, doublereal *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_( integer *, doublereal *, doublecomplex *, integer *); extern integer izamax_(integer *, doublecomplex *, integer *); logical rightv; extern doublereal dzasum_(integer *, doublecomplex *, integer *); @@ -353,7 +353,7 @@ int ztrevc_(char *side, char *howmny, logical *select, integer *n, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZTREVC", &i__1); + xerbla_("ZTREVC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrevc3.c b/src/map/lapack2flamec/f2c/c/ztrevc3.c index fc8a81d67..5abf46891 100644 --- a/src/map/lapack2flamec/f2c/c/ztrevc3.c +++ b/src/map/lapack2flamec/f2c/c/ztrevc3.c @@ -13,7 +13,6 @@ static doublecomplex c_b2 = ; static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b ZTREVC3 */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -260,8 +259,7 @@ int ztrevc3_(char *side, char *howmny, logical *select, integer *n, doublecomple AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("ztrevc3 inputs: side %c, howmny %c, n %" FLA_IS ", ldt %" FLA_IS ", ldvl %" FLA_IS ", ldvr %" FLA_IS ", mm %" FLA_IS ", m %" FLA_IS "",*side, *howmny, *n, *ldt, *ldvl, *ldvr, *mm, *m); /* System generated locals */ - address a__1[2]; - integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2[2], i__3, i__4, i__5, i__6; + integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__3, i__4, i__5, i__6; doublereal d__1, d__2, d__3; doublecomplex z__1, z__2; char ch__1[2]; @@ -289,7 +287,7 @@ int ztrevc3_(char *side, char *howmny, logical *select, integer *n, doublecomple int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), dlabad_(doublereal *, doublereal *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *); @@ -423,7 +421,7 @@ int ztrevc3_(char *side, char *howmny, logical *select, integer *n, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZTREVC3", &i__1); + xerbla_("ZTREVC3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrexc.c b/src/map/lapack2flamec/f2c/c/ztrexc.c index 4ca4e1642..de4cfa778 100644 --- a/src/map/lapack2flamec/f2c/c/ztrexc.c +++ b/src/map/lapack2flamec/f2c/c/ztrexc.c @@ -134,7 +134,7 @@ int ztrexc_(char *compq, integer *n, doublecomplex *t, integer *ldt, doublecompl extern logical lsame_(char *, char *); logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *), zlartg_( doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlartg_( doublecomplex *, doublecomplex *, doublereal *, doublecomplex *, doublecomplex *); /* -- LAPACK computational routine (version 3.7.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -191,7 +191,7 @@ int ztrexc_(char *compq, integer *n, doublecomplex *t, integer *ldt, doublecompl if (*info != 0) { i__1 = -(*info); - xerbla_("ZTREXC", &i__1); + xerbla_("ZTREXC", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrrfs.c b/src/map/lapack2flamec/f2c/c/ztrrfs.c index db7121fc5..8ad5894e5 100644 --- a/src/map/lapack2flamec/f2c/c/ztrrfs.c +++ b/src/map/lapack2flamec/f2c/c/ztrrfs.c @@ -196,7 +196,7 @@ int ztrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub extern doublereal dlamch_(char *); doublereal safmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; char transn[1], transt[1]; logical nounit; @@ -282,7 +282,7 @@ int ztrrfs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRRFS", &i__1); + xerbla_("ZTRRFS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrsen.c b/src/map/lapack2flamec/f2c/c/ztrsen.c index 0e88c87ae..b8b224f1e 100644 --- a/src/map/lapack2flamec/f2c/c/ztrsen.c +++ b/src/map/lapack2flamec/f2c/c/ztrsen.c @@ -278,7 +278,7 @@ int ztrsen_(char *job, char *compq, logical *select, integer *n, doublecomplex * logical wantq, wants; doublereal rnorm, rwork[1]; extern /* Subroutine */ - int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *); + int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); logical wantbh; extern /* Subroutine */ @@ -327,6 +327,7 @@ int ztrsen_(char *job, char *compq, logical *select, integer *n, doublecomplex * wants = lsame_(job, "E") || wantbh; wantsp = lsame_(job, "V") || wantbh; wantq = lsame_(compq, "V"); + lwmin = 0; /* Set M to the number of selected eigenvalues. */ *m = 0; i__1 = *n; @@ -392,7 +393,7 @@ int ztrsen_(char *job, char *compq, logical *select, integer *n, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRSEN", &i__1); + xerbla_("ZTRSEN", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrsna.c b/src/map/lapack2flamec/f2c/c/ztrsna.c index f095e9551..9ff912e5f 100644 --- a/src/map/lapack2flamec/f2c/c/ztrsna.c +++ b/src/map/lapack2flamec/f2c/c/ztrsna.c @@ -269,7 +269,7 @@ int ztrsna_(char *job, char *howmny, logical *select, integer *n, doublecomplex int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), dlabad_( doublereal *, doublereal *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_( char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal bignum; logical wantbh; extern integer izamax_(integer *, doublecomplex *, integer *); @@ -389,7 +389,7 @@ int ztrsna_(char *job, char *howmny, logical *select, integer *n, doublecomplex if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRSNA", &i__1); + xerbla_("ZTRSNA", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrsyl.c b/src/map/lapack2flamec/f2c/c/ztrsyl.c index c9fd8fc35..f9d534cd9 100644 --- a/src/map/lapack2flamec/f2c/c/ztrsyl.c +++ b/src/map/lapack2flamec/f2c/c/ztrsyl.c @@ -175,13 +175,13 @@ int ztrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dou extern doublereal dlamch_(char *); doublereal scaloc; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; extern /* Subroutine */ int zdscal_(integer *, doublereal *, doublecomplex *, integer *); extern /* Double Complex */ - VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *); + void zladiv_f2c_(doublecomplex *, doublecomplex *, doublecomplex *); logical notrna, notrnb; doublereal smlnum; /* -- LAPACK computational routine (version 3.4.0) -- */ @@ -256,7 +256,7 @@ int ztrsyl_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, dou if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRSYL", &i__1); + xerbla_("ZTRSYL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrsyl3.c b/src/map/lapack2flamec/f2c/c/ztrsyl3.c index 575e54c33..842ee1dfa 100644 --- a/src/map/lapack2flamec/f2c/c/ztrsyl3.c +++ b/src/map/lapack2flamec/f2c/c/ztrsyl3.c @@ -174,7 +174,8 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do doublereal buf, sgn, scal; doublecomplex csgn; doublereal anrm, bnrm, cnrm; - integer awrk, bwrk, temp; + integer awrk, bwrk; + int temp; doublereal *wnrm, xnrm; extern logical lsame_(char *, char *); integer iinfo; @@ -184,7 +185,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do doublereal scaloc, scamin; extern doublereal dlarmm_(doublereal *, doublereal *, doublereal *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *); doublereal bignum; @@ -286,7 +287,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRSYL3", &i__1); + xerbla_("ZTRSYL3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } @@ -452,7 +453,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do } else { - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__2 = nbb; @@ -470,7 +471,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -506,7 +507,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -519,15 +520,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -594,7 +595,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -607,15 +608,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -711,7 +712,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__3 = nbb; @@ -729,7 +730,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -766,7 +767,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__4 = nbb; for (jj = 1; @@ -779,15 +780,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -854,7 +855,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__4 = nbb; for (jj = 1; @@ -867,15 +868,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -970,7 +971,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__2 = nbb; @@ -988,7 +989,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -1025,7 +1026,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -1038,15 +1039,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1113,7 +1114,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__3 = nbb; for (jj = 1; @@ -1126,15 +1127,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1228,7 +1229,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do else { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); } i__1 = nbb; @@ -1246,7 +1247,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do corresponding entries of the */ /* solution will be flushed in consistency scaling. */ /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); @@ -1283,7 +1284,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -1296,15 +1297,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; @@ -1371,7 +1372,7 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do if (scaloc * scamin == 0.) { /* Use second scaling factor to prevent flushing to zero. */ - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; buf *= pow_dd(&c_b18, &d__1); i__2 = nbb; for (jj = 1; @@ -1384,15 +1385,15 @@ int ztrsyl3_(char *trana, char *tranb, integer *isgn, integer *m, integer *n, do ++ll) { /* Computing fla_min */ - frexp(scaloc, &temp); d__3 = temp; + frexp(scaloc, (int *) &temp); d__3 = temp; d__1 = bignum; d__2 = swork[ll + jj * swork_dim1] / pow_dd(&c_b18, &d__3); // , expr subst swork[ll + jj * swork_dim1] = fla_min(d__1,d__2); } } - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scamin /= pow_dd(&c_b18, &d__1); - frexp(scaloc, &temp); d__1 = temp; + frexp(scaloc, (int *) &temp); d__1 = temp; scaloc /= pow_dd(&c_b18, &d__1); } cnrm *= scaloc; diff --git a/src/map/lapack2flamec/f2c/c/ztrtrs.c b/src/map/lapack2flamec/f2c/c/ztrtrs.c index eeefdf333..a4d47466a 100644 --- a/src/map/lapack2flamec/f2c/c/ztrtrs.c +++ b/src/map/lapack2flamec/f2c/c/ztrtrs.c @@ -142,7 +142,7 @@ int ztrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ - int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nounit; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -206,7 +206,7 @@ int ztrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRTRS", &i__1); + xerbla_("ZTRTRS", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrttf.c b/src/map/lapack2flamec/f2c/c/ztrttf.c index 6797dae5e..8ecce27d7 100644 --- a/src/map/lapack2flamec/f2c/c/ztrttf.c +++ b/src/map/lapack2flamec/f2c/c/ztrttf.c @@ -220,7 +220,7 @@ int ztrttf_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *lda extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical nisodd; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -270,7 +270,7 @@ int ztrttf_(char *transr, char *uplo, integer *n, doublecomplex *a, integer *lda if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRTTF", &i__1); + xerbla_("ZTRTTF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztrttp.c b/src/map/lapack2flamec/f2c/c/ztrttp.c index 177dfa93d..1732c7387 100644 --- a/src/map/lapack2flamec/f2c/c/ztrttp.c +++ b/src/map/lapack2flamec/f2c/c/ztrttp.c @@ -103,7 +103,7 @@ int ztrttp_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomple extern logical lsame_(char *, char *); logical lower; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -146,7 +146,7 @@ int ztrttp_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZTRTTP", &i__1); + xerbla_("ZTRTTP", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztzrqf.c b/src/map/lapack2flamec/f2c/c/ztzrqf.c index f86774e6e..547574a8b 100644 --- a/src/map/lapack2flamec/f2c/c/ztzrqf.c +++ b/src/map/lapack2flamec/f2c/c/ztzrqf.c @@ -144,7 +144,7 @@ int ztzrqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple integer i__, k, m1; doublecomplex alpha; extern /* Subroutine */ - int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); + int zgerc_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -186,7 +186,7 @@ int ztzrqf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZTZRQF", &i__1); + xerbla_("ZTZRQF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/ztzrzf.c b/src/map/lapack2flamec/f2c/c/ztzrzf.c index 30c583301..0a56dcc58 100644 --- a/src/map/lapack2flamec/f2c/c/ztzrzf.c +++ b/src/map/lapack2flamec/f2c/c/ztzrzf.c @@ -151,7 +151,7 @@ int ztzrzf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Local variables */ integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkmin, ldwork; extern /* Subroutine */ @@ -190,6 +190,7 @@ int ztzrzf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple /* Function Body */ *info = 0; lquery = *lwork == -1; + nb = 0; if (*m < 0) { *info = -1; @@ -226,7 +227,7 @@ int ztzrzf_(integer *m, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZTZRZF", &i__1); + xerbla_("ZTZRZF", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb.c b/src/map/lapack2flamec/f2c/c/zunbdb.c index 7a0640475..36d58a2ca 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb.c @@ -302,7 +302,7 @@ int zunbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, double int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical lquery; extern /* Subroutine */ int zlarfgp_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); @@ -448,7 +448,7 @@ int zunbdb_(char *trans, char *signs, integer *m, integer *p, integer *q, double if (*info != 0) { i__1 = -(*info); - xerbla_("xORBDB", &i__1); + xerbla_("xORBDB", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb1.c b/src/map/lapack2flamec/f2c/c/zunbdb1.c index e86ed70cd..da6c8a191 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb1.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb1.c @@ -212,7 +212,7 @@ int zunbdb1_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -306,7 +306,7 @@ int zunbdb1_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB1", &i__1); + xerbla_("ZUNBDB1", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb2.c b/src/map/lapack2flamec/f2c/c/zunbdb2.c index 98cab0e67..bae8c970e 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb2.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb2.c @@ -214,7 +214,7 @@ int zunbdb2_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -308,7 +308,7 @@ int zunbdb2_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB2", &i__1); + xerbla_("ZUNBDB2", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb3.c b/src/map/lapack2flamec/f2c/c/zunbdb3.c index 57d99727b..895b92347 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb3.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb3.c @@ -209,7 +209,7 @@ int zunbdb3_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -303,7 +303,7 @@ int zunbdb3_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB3", &i__1); + xerbla_("ZUNBDB3", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb4.c b/src/map/lapack2flamec/f2c/c/zunbdb4.c index c5e9262cc..031cd0fe3 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb4.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb4.c @@ -227,7 +227,7 @@ int zunbdb4_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), zdrot_(integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *); extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlacgv_( integer *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_( integer *, doublecomplex *, integer *); logical lquery; integer iorbdb5, lorbdb5; extern /* Subroutine */ @@ -323,7 +323,7 @@ int zunbdb4_(integer *m, integer *p, integer *q, doublecomplex *x11, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB4", &i__1); + xerbla_("ZUNBDB4", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb5.c b/src/map/lapack2flamec/f2c/c/zunbdb5.c index 1b4147c39..acf174fec 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb5.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb5.c @@ -152,7 +152,7 @@ int zunbdb5_(integer *m1, integer *m2, integer *n, doublecomplex *x1, integer *i integer i__, j, childinfo; extern doublereal dznrm2_(integer *, doublecomplex *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *), zunbdb6_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *) ; + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zunbdb6_( integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *) ; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -221,7 +221,7 @@ int zunbdb5_(integer *m1, integer *m2, integer *n, doublecomplex *x1, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB5", &i__1); + xerbla_("ZUNBDB5", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunbdb6.c b/src/map/lapack2flamec/f2c/c/zunbdb6.c index dc1bfa88a..197a5a015 100644 --- a/src/map/lapack2flamec/f2c/c/zunbdb6.c +++ b/src/map/lapack2flamec/f2c/c/zunbdb6.c @@ -177,7 +177,7 @@ int zunbdb6_(integer *m1, integer *m2, integer *n, doublecomplex *x1, integer *i int zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); extern doublereal dlamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), zlassq_( integer *, doublecomplex *, integer *, doublereal *, doublereal *) ; + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlassq_( integer *, doublecomplex *, integer *, doublereal *, doublereal *) ; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -245,7 +245,7 @@ int zunbdb6_(integer *m1, integer *m2, integer *n, doublecomplex *x1, integer *i if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNBDB6", &i__1); + xerbla_("ZUNBDB6", &i__1, (ftnlen)7); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zuncsd.c b/src/map/lapack2flamec/f2c/c/zuncsd.c index 1e73f65b0..d15ecad78 100644 --- a/src/map/lapack2flamec/f2c/c/zuncsd.c +++ b/src/map/lapack2flamec/f2c/c/zuncsd.c @@ -329,7 +329,7 @@ int zuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, int zbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); integer lorgqrworkmin; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lorglqworkopt; extern /* Subroutine */ int zunbdb_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *, integer *, integer *); @@ -407,6 +407,21 @@ int zuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, defaultsigns = ! lsame_(signs, "O"); lquery = *lwork == -1; lrquery = *lrwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + itauq2 = 0; + itauq1 = 0; + itaup2 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -7; @@ -657,7 +672,7 @@ int zuncsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNCSD", &i__1); + xerbla_("ZUNCSD", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zuncsd2by1.c b/src/map/lapack2flamec/f2c/c/zuncsd2by1.c index d190ff808..494d5f935 100644 --- a/src/map/lapack2flamec/f2c/c/zuncsd2by1.c +++ b/src/map/lapack2flamec/f2c/c/zuncsd2by1.c @@ -265,7 +265,7 @@ int zuncsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, logical wantu1, wantu2; integer ibbcsd, lbbcsd, iorbdb, lorbdb; extern /* Subroutine */ - int zbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int zbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer iorglq, lorglq; extern /* Subroutine */ int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -649,7 +649,7 @@ int zuncsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNCSD2BY1", &i__1); + xerbla_("ZUNCSD2BY1", &i__1, (ftnlen)10); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zung2l.c b/src/map/lapack2flamec/f2c/c/zung2l.c index 2954e2186..287a98601 100644 --- a/src/map/lapack2flamec/f2c/c/zung2l.c +++ b/src/map/lapack2flamec/f2c/c/zung2l.c @@ -112,7 +112,7 @@ int zung2l_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -159,7 +159,7 @@ int zung2l_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNG2L", &i__1); + xerbla_("ZUNG2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zung2r.c b/src/map/lapack2flamec/f2c/c/zung2r.c index 181d557d0..54544504d 100644 --- a/src/map/lapack2flamec/f2c/c/zung2r.c +++ b/src/map/lapack2flamec/f2c/c/zung2r.c @@ -115,7 +115,7 @@ int zung2r_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern int fla_zscal(integer *, doublecomplex *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -167,7 +167,7 @@ int zung2r_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNG2R", &i__1); + xerbla_("ZUNG2R", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungbr.c b/src/map/lapack2flamec/f2c/c/zungbr.c index 291c5af84..9773fbb4c 100644 --- a/src/map/lapack2flamec/f2c/c/zungbr.c +++ b/src/map/lapack2flamec/f2c/c/zungbr.c @@ -162,7 +162,7 @@ int zungbr_(char *vect, integer *m, integer *n, integer *k, doublecomplex *a, in integer iinfo; logical wantq; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lwkopt; logical lquery; extern /* Subroutine */ @@ -267,7 +267,7 @@ int zungbr_(char *vect, integer *m, integer *n, integer *k, doublecomplex *a, in if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGBR", &i__1); + xerbla_("ZUNGBR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunghr.c b/src/map/lapack2flamec/f2c/c/zunghr.c index ee274e3ed..c7c015b8b 100644 --- a/src/map/lapack2flamec/f2c/c/zunghr.c +++ b/src/map/lapack2flamec/f2c/c/zunghr.c @@ -126,7 +126,7 @@ int zunghr_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l /* Local variables */ integer i__, j, nb, nh, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -193,7 +193,7 @@ int zunghr_(integer *n, integer *ilo, integer *ihi, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGHR", &i__1); + xerbla_("ZUNGHR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungl2.c b/src/map/lapack2flamec/f2c/c/zungl2.c index f57c211f2..bcdf1b8a8 100644 --- a/src/map/lapack2flamec/f2c/c/zungl2.c +++ b/src/map/lapack2flamec/f2c/c/zungl2.c @@ -111,7 +111,7 @@ int zungl2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int zungl2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGL2", &i__1); + xerbla_("ZUNGL2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunglq.c b/src/map/lapack2flamec/f2c/c/zunglq.c index 4582eae12..c5be03134 100644 --- a/src/map/lapack2flamec/f2c/c/zunglq.c +++ b/src/map/lapack2flamec/f2c/c/zunglq.c @@ -129,7 +129,7 @@ int zunglq_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zungl2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zungl2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -195,7 +195,7 @@ int zunglq_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGLQ", &i__1); + xerbla_("ZUNGLQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungql.c b/src/map/lapack2flamec/f2c/c/zungql.c index af6e4a0c8..eb270aeb9 100644 --- a/src/map/lapack2flamec/f2c/c/zungql.c +++ b/src/map/lapack2flamec/f2c/c/zungql.c @@ -129,7 +129,7 @@ int zungql_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ib, nb, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zung2l_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zung2l_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -168,6 +168,7 @@ int zungql_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Function Body */ *info = 0; lquery = *lwork == -1; + nb = 0; if (*m < 0) { *info = -1; @@ -205,7 +206,7 @@ int zungql_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGQL", &i__1); + xerbla_("ZUNGQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungqr.c b/src/map/lapack2flamec/f2c/c/zungqr.c index a110a41b8..7b7091f95 100644 --- a/src/map/lapack2flamec/f2c/c/zungqr.c +++ b/src/map/lapack2flamec/f2c/c/zungqr.c @@ -4,7 +4,6 @@ /* ../netlib/zungqr.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ -static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; @@ -132,7 +131,7 @@ int zungqr_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -173,6 +172,7 @@ int zungqr_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, #ifdef FLA_ENABLE_AMD_OPT nb = FLA_ZUNGQR_BLOCK_SMALL_THRESH; #else + integer c__1 = 1; nb = ilaenv_(&c__1, "ZUNGQR", " ", m, n, k, &c_n1); #endif lwkopt = fla_max(1,*n) * nb; @@ -202,7 +202,7 @@ int zungqr_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGQR", &i__1); + xerbla_("ZUNGQR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungr2.c b/src/map/lapack2flamec/f2c/c/zungr2.c index 4dc092740..1f2001a97 100644 --- a/src/map/lapack2flamec/f2c/c/zungr2.c +++ b/src/map/lapack2flamec/f2c/c/zungr2.c @@ -112,7 +112,7 @@ int zungr2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ii; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -159,7 +159,7 @@ int zungr2_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGR2", &i__1); + xerbla_("ZUNGR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungrq.c b/src/map/lapack2flamec/f2c/c/zungrq.c index 086c1a760..bb2a6f03c 100644 --- a/src/map/lapack2flamec/f2c/c/zungrq.c +++ b/src/map/lapack2flamec/f2c/c/zungrq.c @@ -129,7 +129,7 @@ int zungrq_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Local variables */ integer i__, j, l, ib, nb, ii, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zungr2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zungr2_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -168,6 +168,7 @@ int zungrq_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, /* Function Body */ *info = 0; lquery = *lwork == -1; + nb = 0; if (*m < 0) { *info = -1; @@ -205,7 +206,7 @@ int zungrq_(integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGRQ", &i__1); + xerbla_("ZUNGRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungtr.c b/src/map/lapack2flamec/f2c/c/zungtr.c index be3e8c31b..40d67a679 100644 --- a/src/map/lapack2flamec/f2c/c/zungtr.c +++ b/src/map/lapack2flamec/f2c/c/zungtr.c @@ -126,7 +126,7 @@ int zungtr_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomple integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -211,7 +211,7 @@ int zungtr_(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGTR", &i__1); + xerbla_("ZUNGTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungtsqr.c b/src/map/lapack2flamec/f2c/c/zungtsqr.c index d0ce2150e..e56693c61 100644 --- a/src/map/lapack2flamec/f2c/c/zungtsqr.c +++ b/src/map/lapack2flamec/f2c/c/zungtsqr.c @@ -185,7 +185,7 @@ int zungtsqr_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex * int zlamtsqr_(char *, char *, integer *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *); integer lworkopt, j, lc, lw, ldc, iinfo; extern /* Subroutine */ - int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); + int zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaset_(char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); logical lquery; integer nblocal; /* -- LAPACK computational routine (version 3.9.0) -- */ @@ -278,7 +278,7 @@ int zungtsqr_(integer *m, integer *n, integer *mb, integer * nb, doublecomplex * if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGTSQR", &i__1); + xerbla_("ZUNGTSQR", &i__1, (ftnlen)8); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zungtsqr_row.c b/src/map/lapack2flamec/f2c/c/zungtsqr_row.c index b93226d3c..a45abdc73 100644 --- a/src/map/lapack2flamec/f2c/c/zungtsqr_row.c +++ b/src/map/lapack2flamec/f2c/c/zungtsqr_row.c @@ -202,7 +202,7 @@ int zungtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, doublecomple doublecomplex dummy[1] /* was [1][1] */ ; extern /* Subroutine */ - int xerbla_(char *, integer *), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlaset_( char *, integer *, integer *, doublecomplex *, doublecomplex *, doublecomplex *, integer *); logical lquery; integer nblocal, kb_last__; /* -- LAPACK computational routine -- */ @@ -283,7 +283,7 @@ int zungtsqr_row_(integer *m, integer *n, integer *mb, integer *nb, doublecomple if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGTSQR_ROW", &i__1); + xerbla_("ZUNGTSQR_ROW", &i__1, (ftnlen)12); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunhr_col.c b/src/map/lapack2flamec/f2c/c/zunhr_col.c index ca1c7531c..22d12ef62 100644 --- a/src/map/lapack2flamec/f2c/c/zunhr_col.c +++ b/src/map/lapack2flamec/f2c/c/zunhr_col.c @@ -277,7 +277,7 @@ int zunhr_col_(integer *m, integer *n, integer *nb, doublecomplex *a, integer *l int zlaunhr_col_getrfnp_(integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); integer iinfo; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zcopy_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer jbtemp1, jbtemp2; /* -- LAPACK computational routine (version 3.9.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -338,7 +338,7 @@ int zunhr_col_(integer *m, integer *n, integer *nb, doublecomplex *a, integer *l if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNHR_COL", &i__1); + xerbla_("ZUNHR_COL", &i__1, (ftnlen)9); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunm22.c b/src/map/lapack2flamec/f2c/c/zunm22.c index de6d49800..0f5b1f121 100644 --- a/src/map/lapack2flamec/f2c/c/zunm22.c +++ b/src/map/lapack2flamec/f2c/c/zunm22.c @@ -170,7 +170,7 @@ int zunm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; integer ldwork; extern /* Subroutine */ @@ -273,7 +273,7 @@ int zunm22_(char *side, char *trans, integer *m, integer *n, integer *n1, intege if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNM22", &i__1); + xerbla_("ZUNM22", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunm2l.c b/src/map/lapack2flamec/f2c/c/zunm2l.c index 297937bc8..e61a3cf24 100644 --- a/src/map/lapack2flamec/f2c/c/zunm2l.c +++ b/src/map/lapack2flamec/f2c/c/zunm2l.c @@ -164,7 +164,7 @@ int zunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doublec doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int zunm2l_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNM2L", &i__1); + xerbla_("ZUNM2L", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunm2r.c b/src/map/lapack2flamec/f2c/c/zunm2r.c index 76f5c7178..6a744e0b8 100644 --- a/src/map/lapack2flamec/f2c/c/zunm2r.c +++ b/src/map/lapack2flamec/f2c/c/zunm2r.c @@ -164,7 +164,7 @@ int zunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doublec doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int zunm2r_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNM2R", &i__1); + xerbla_("ZUNM2R", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmbr.c b/src/map/lapack2flamec/f2c/c/zunmbr.c index b34971353..c15db4b2f 100644 --- a/src/map/lapack2flamec/f2c/c/zunmbr.c +++ b/src/map/lapack2flamec/f2c/c/zunmbr.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b ZUNMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -198,8 +197,7 @@ int zunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zunmbr inputs: vect %c, side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "", *vect, *side, *trans, *m, *n, *k, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -210,7 +208,7 @@ int zunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran, applyq; char transt[1]; @@ -350,7 +348,7 @@ int zunmbr_(char *vect, char *side, char *trans, integer *m, integer *n, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMBR", &i__1); + xerbla_("ZUNMBR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmhr.c b/src/map/lapack2flamec/f2c/c/zunmhr.c index 652a4223e..b8329643c 100644 --- a/src/map/lapack2flamec/f2c/c/zunmhr.c +++ b/src/map/lapack2flamec/f2c/c/zunmhr.c @@ -3,7 +3,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; -static integer c__2 = 2; /* > \brief \b ZUNMHR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -176,8 +175,7 @@ int zunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zunmhr inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", ilo %" FLA_IS ", ihi %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "", *side, *trans, *m, *n, *ilo, *ihi, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2; + integer a_dim1, a_offset, c_dim1, c_offset, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -188,7 +186,7 @@ int zunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -290,7 +288,7 @@ int zunmhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ if (*info != 0) { i__2 = -(*info); - xerbla_("ZUNMHR", &i__2); + xerbla_("ZUNMHR", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunml2.c b/src/map/lapack2flamec/f2c/c/zunml2.c index f4942aa8a..2a72cf41c 100644 --- a/src/map/lapack2flamec/f2c/c/zunml2.c +++ b/src/map/lapack2flamec/f2c/c/zunml2.c @@ -161,7 +161,7 @@ int zunml2_(char *side, char *trans, integer *m, integer *n, integer *k, doublec doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -237,7 +237,7 @@ int zunml2_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNML2", &i__1); + xerbla_("ZUNML2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmlq.c b/src/map/lapack2flamec/f2c/c/zunmlq.c index e2bd29f76..4c44f6cd5 100644 --- a/src/map/lapack2flamec/f2c/c/zunmlq.c +++ b/src/map/lapack2flamec/f2c/c/zunmlq.c @@ -179,8 +179,7 @@ int zunmlq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec int fla_zunmlq(char *side, char *trans, integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -191,7 +190,7 @@ int fla_zunmlq(char *side, char *trans, integer *m, integer *n, integer *k, doub extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunml2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunml2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -300,7 +299,7 @@ int fla_zunmlq(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMLQ", &i__1); + xerbla_("ZUNMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/zunmql.c b/src/map/lapack2flamec/f2c/c/zunmql.c index 2a1dda5da..aee5bb1e5 100644 --- a/src/map/lapack2flamec/f2c/c/zunmql.c +++ b/src/map/lapack2flamec/f2c/c/zunmql.c @@ -168,8 +168,7 @@ int zunmql_(char *side, char *trans, integer *m, integer *n, integer *k, doublec AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zunmql inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "", *side, *trans, *m, *n, *k, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -180,7 +179,7 @@ int zunmql_(char *side, char *trans, integer *m, integer *n, integer *k, doublec extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunm2l_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunm2l_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -225,6 +224,7 @@ int zunmql_(char *side, char *trans, integer *m, integer *n, integer *k, doublec left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; + nb = 0; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { @@ -289,7 +289,7 @@ int zunmql_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMQL", &i__1); + xerbla_("ZUNMQL", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmqr.c b/src/map/lapack2flamec/f2c/c/zunmqr.c index 301ae47c9..74d655f54 100644 --- a/src/map/lapack2flamec/f2c/c/zunmqr.c +++ b/src/map/lapack2flamec/f2c/c/zunmqr.c @@ -179,8 +179,7 @@ int zunmqr_(char *side, char *trans, integer *m, integer *n, integer *k, doublec int fla_zunmqr(char *side, char *trans, integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -191,7 +190,7 @@ int fla_zunmqr(char *side, char *trans, integer *m, integer *n, integer *k, doub extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunm2r_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -299,7 +298,7 @@ int fla_zunmqr(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMQR", &i__1); + xerbla_("ZUNMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/c/zunmr2.c b/src/map/lapack2flamec/f2c/c/zunmr2.c index 33b5dc64e..9bbb0a472 100644 --- a/src/map/lapack2flamec/f2c/c/zunmr2.c +++ b/src/map/lapack2flamec/f2c/c/zunmr2.c @@ -161,7 +161,7 @@ int zunmr2_(char *side, char *trans, integer *m, integer *n, integer *k, doublec doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -237,7 +237,7 @@ int zunmr2_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMR2", &i__1); + xerbla_("ZUNMR2", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmr3.c b/src/map/lapack2flamec/f2c/c/zunmr3.c index fb5353d23..880a06e03 100644 --- a/src/map/lapack2flamec/f2c/c/zunmr3.c +++ b/src/map/lapack2flamec/f2c/c/zunmr3.c @@ -178,7 +178,7 @@ int zunmr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarz_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zlarz_(char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -256,7 +256,7 @@ int zunmr3_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMR3", &i__1); + xerbla_("ZUNMR3", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmrq.c b/src/map/lapack2flamec/f2c/c/zunmrq.c index 882ad7f3c..efaaa3ff6 100644 --- a/src/map/lapack2flamec/f2c/c/zunmrq.c +++ b/src/map/lapack2flamec/f2c/c/zunmrq.c @@ -167,8 +167,7 @@ int zunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zunmrq inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "", *side, *trans, *m, *n, *k, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -179,7 +178,7 @@ int zunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunmr2_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -225,6 +224,7 @@ int zunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec left = lsame_(side, "L"); notran = lsame_(trans, "N"); lquery = *lwork == -1; + nb = 0; /* NQ is the order of Q and NW is the minimum dimension of WORK */ if (left) { @@ -289,7 +289,7 @@ int zunmrq_(char *side, char *trans, integer *m, integer *n, integer *k, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMRQ", &i__1); + xerbla_("ZUNMRQ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmrz.c b/src/map/lapack2flamec/f2c/c/zunmrz.c index 51c09ea48..b9fd86321 100644 --- a/src/map/lapack2flamec/f2c/c/zunmrz.c +++ b/src/map/lapack2flamec/f2c/c/zunmrz.c @@ -186,8 +186,7 @@ int zunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer AOCL_DTL_TRACE_LOG_INIT AOCL_DTL_SNPRINTF("zunmrz inputs: side %c, trans %c, m %" FLA_IS ", n %" FLA_IS ", k %" FLA_IS ", l %" FLA_IS ", lda %" FLA_IS ", ldc %" FLA_IS ", lwork %" FLA_IS "", *side, *trans, *m, *n, *k, *l, *lda, *ldc, *lwork); /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__4, i__5; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -198,7 +197,7 @@ int zunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunmr3_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunmr3_(char *, char *, integer *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -312,7 +311,7 @@ int zunmrz_(char *side, char *trans, integer *m, integer *n, integer *k, integer if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMRZ", &i__1); + xerbla_("ZUNMRZ", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zunmtr.c b/src/map/lapack2flamec/f2c/c/zunmtr.c index 366cf6373..e2df2e81a 100644 --- a/src/map/lapack2flamec/f2c/c/zunmtr.c +++ b/src/map/lapack2flamec/f2c/c/zunmtr.c @@ -183,7 +183,7 @@ int zunmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doublec integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -304,7 +304,7 @@ int zunmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doublec if (*info != 0) { i__2 = -(*info); - xerbla_("ZUNMTR", &i__2); + xerbla_("ZUNMTR", &i__2, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zupgtr.c b/src/map/lapack2flamec/f2c/c/zupgtr.c index f466422f9..611f1be17 100644 --- a/src/map/lapack2flamec/f2c/c/zupgtr.c +++ b/src/map/lapack2flamec/f2c/c/zupgtr.c @@ -113,7 +113,7 @@ int zupgtr_(char *uplo, integer *n, doublecomplex *ap, doublecomplex *tau, doubl integer iinfo; logical upper; extern /* Subroutine */ - int zung2l_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zung2l_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -160,7 +160,7 @@ int zupgtr_(char *uplo, integer *n, doublecomplex *ap, doublecomplex *tau, doubl if (*info != 0) { i__1 = -(*info); - xerbla_("ZUPGTR", &i__1); + xerbla_("ZUPGTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/c/zupmtr.c b/src/map/lapack2flamec/f2c/c/zupmtr.c index e35c33356..caa16274d 100644 --- a/src/map/lapack2flamec/f2c/c/zupmtr.c +++ b/src/map/lapack2flamec/f2c/c/zupmtr.c @@ -160,7 +160,7 @@ int zupmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doublec int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran, forwrd; /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int zupmtr_(char *side, char *uplo, char *trans, integer *m, integer *n, doublec if (*info != 0) { i__1 = -(*info); - xerbla_("ZUPMTR", &i__1); + xerbla_("ZUPMTR", &i__1, (ftnlen)6); AOCL_DTL_TRACE_LOG_EXIT return 0; } diff --git a/src/map/lapack2flamec/f2c/flamec/CMakeLists.txt b/src/map/lapack2flamec/f2c/flamec/CMakeLists.txt index 5ea67fcd3..fd1889353 100644 --- a/src/map/lapack2flamec/f2c/flamec/CMakeLists.txt +++ b/src/map/lapack2flamec/f2c/flamec/CMakeLists.txt @@ -2,5 +2,6 @@ add_subdirectory(front) add_subdirectory(gelq) add_subdirectory(geqr) +add_subdirectory(hegs) add_subdirectory(hetd) add_subdirectory(spffrt) \ No newline at end of file diff --git a/src/map/lapack2flamec/f2c/flamec/front/dopgtr.c b/src/map/lapack2flamec/f2c/flamec/front/dopgtr.c index 0c7e45413..0c5b359f1 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/dopgtr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/dopgtr.c @@ -111,7 +111,7 @@ int dopgtr_(char *uplo, integer *n, doublereal *ap, doublereal *tau, doublereal integer iinfo; logical upper; extern /* Subroutine */ - int dorg2l_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorg2l_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dorg2r_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int dopgtr_(char *uplo, integer *n, doublereal *ap, doublereal *tau, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DOPGTR", &i__1); + xerbla_("DOPGTR", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/front/dorcsd.c b/src/map/lapack2flamec/f2c/flamec/front/dorcsd.c index a1838e033..33b2b8303 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/dorcsd.c +++ b/src/map/lapack2flamec/f2c/flamec/front/dorcsd.c @@ -300,7 +300,7 @@ int dorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, integer lworkmin, lworkopt, i__, j, childinfo, lbbcsdwork, lorbdbwork, lorglqwork, lorgqrwork, ib11d, ib11e, ib12d, ib12e, ib21d, ib21e, ib22d, ib22e, iphi; logical defaultsigns; extern logical lsame_(char *, char *); - integer lbbcsdworkmin, itaup1, itaup2, itauq1, itauq2, lorbdbworkmin, lbbcsdworkopt; + integer lbbcsdworkmin, itaup1, itaup2, itauq1, itauq2, lbbcsdworkopt; logical wantu1, wantu2; extern /* Subroutine */ int dbbcsd_(char *, char *, char *, char *, char * , integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); @@ -309,7 +309,7 @@ int dorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, int dorbdb_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); integer iorbdb, lorglqworkmin, lorgqrworkmin; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlapmr_(logical *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(char *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlapmr_(logical *, integer *, integer *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); integer lorglqworkopt; extern /* Subroutine */ int dorglq_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); @@ -377,6 +377,23 @@ int dorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, colmajor = ! lsame_(trans, "T"); defaultsigns = ! lsame_(signs, "O"); lquery = *lwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + ibbcsd = 0; + itauq2 = 0; + itauq1 = 0; + itaup2 = 0; + itaup1 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -7; @@ -562,7 +579,6 @@ int dorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, iorbdb = itauq2 + fla_max(i__1,i__2); dorbdb_(trans, signs, m, p, q, &x11[x11_offset], ldx11, &x12[ x12_offset], ldx12, &x21[x21_offset], ldx21, &x22[x22_offset], ldx22, &theta[1], &v1t[v1t_offset], &u1[u1_offset], &u2[ u2_offset], &v1t[v1t_offset], &v2t[v2t_offset], &work[1], & c_n1, &childinfo); lorbdbworkopt = (integer) work[1]; - lorbdbworkmin = lorbdbworkopt; /* Computing MAX */ i__1 = 1; i__2 = *m - *q; // , expr subst @@ -617,7 +633,7 @@ int dorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("DORCSD", &i__1); + xerbla_("DORCSD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/front/dorcsd2by1.c b/src/map/lapack2flamec/f2c/flamec/front/dorcsd2by1.c index fb43b0a9b..feeadbe1a 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/dorcsd2by1.c +++ b/src/map/lapack2flamec/f2c/flamec/front/dorcsd2by1.c @@ -241,18 +241,16 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); integer itaup1, itaup2, itauq1; logical wantu1, wantu2; - extern /* Subroutine */ - int dbbcsd_(); integer ibbcsd, lbbcsd, iorbdb, lorbdb; extern /* Subroutine */ - int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *), dlapmr_(logical *, integer *, integer *, doublereal *, integer *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); + int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), dlapmr_(logical *, integer *, integer *, doublereal *, integer *, integer *), dlapmt_(logical *, integer *, integer *, doublereal *, integer *, integer *); integer iorglq; extern int /* Subroutine */ dorglq_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), lapack_dorgqr(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); integer lorglq, iorgqr, lorgqr; extern /* Subroutine */ - int dorbdb1_(), dorbdb2_(), dorbdb3_(), dorbdb4_() ; + int dbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dorbdb1_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dorbdb2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dorbdb3_( integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *), dorbdb4_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *, integer *); logical lquery, wantv1t; /* -- LAPACK computational routine (3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -300,6 +298,21 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, wantu2 = lsame_(jobu2, "Y"); wantv1t = lsame_(jobv1t, "Y"); lquery = *lwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + itauq1 = 0; + itaup2 = 0; + itaup1 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -4; @@ -401,7 +414,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, iorglq = itauq1 + fla_max(1,*q); if (r__ == *q) { - dorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + dorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p >= *m - *p) { @@ -438,12 +451,12 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, i__2 = *q - 1; // , expr subst lorglqmin = fla_max(i__1,i__2); lorglqopt = (integer) work[1]; - dbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &c__0, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo); + dbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], (doublereal*)&c__0, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, (doublereal*)&c__0, &c__1, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], &c_n1, & childinfo); lbbcsd = (integer) work[1]; } else if (r__ == *p) { - dorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + dorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p - 1 >= *m - *p) { @@ -471,12 +484,12 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, dorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, (doublereal*)&c__0, &work[1], & c_n1, &childinfo); lorglqmin = fla_max(1,*q); lorglqopt = (integer) work[1]; - dbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &c__0, &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &c__0, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo); + dbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], (doublereal*)&c__0, &v1t[v1t_offset], ldv1t, (doublereal*)&c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], &c_n1, &childinfo); lbbcsd = (integer) work[1]; } else if (r__ == *m - *p) { - dorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + dorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p >= *m - *p - 1) { @@ -501,12 +514,12 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, lorglqopt = (integer) work[1]; i__1 = *m - *q; i__2 = *m - *p; - dbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1] , &c__0, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo); + dbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1] , (doublereal*)&c__0, (doublereal*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], &c_n1, &childinfo); lbbcsd = (integer) work[1]; } else { - dorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &c__0, & work[1], &c_n1, &childinfo); + dorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, & work[1], &c_n1, &childinfo); lorbdb = *m + (integer) work[1]; if (*p >= *m - *p) { @@ -532,7 +545,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, lorglqopt = (integer) work[1]; i__1 = *m - *p; i__2 = *m - *q; - dbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1] , &c__0, &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, & c__0, &c__1, &v1t[v1t_offset], ldv1t, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo); + dbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1] , (doublereal*)&c__0, &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, (doublereal*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, (doublereal*)&c__0, &work[1], &c_n1, & childinfo); lbbcsd = (integer) work[1]; } /* Computing MAX */ @@ -554,7 +567,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, if (*info != 0) { i__1 = -(*info); - xerbla_("DORCSD2BY1", &i__1); + xerbla_("DORCSD2BY1", &i__1, (ftnlen)10); return 0; } else if (lquery) @@ -604,7 +617,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, dorglq_fla(&i__1, &i__2, &i__3, &v1t[(v1t_dim1 << 1) + 2], ldv1t, & work[itauq1], &work[iorglq], &lorglq, &childinfo); } /* Simultaneously diagonalize X11 and X21. */ - dbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &work[ iphi], &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &work[ib11d], &work[ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + dbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &work[ iphi], &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, (doublereal*)&c__0, &c__1, &work[ib11d], &work[ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place zero submatrices in */ /* preferred positions */ if (*q > 0 && wantu2) @@ -667,7 +680,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, dorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, &work[itauq1], &work[ iorglq], &lorglq, &childinfo); } /* Simultaneously diagonalize X11 and X21. */ - dbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &work[ iphi], &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &work[ib11d], &work[ib11e], &work[ ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ib22d] , &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + dbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &work[ iphi], &v1t[v1t_offset], ldv1t, (doublereal*)&c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &work[ib11d], &work[ib11e], &work[ ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ib22d] , &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*q > 0 && wantu2) @@ -730,7 +743,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, /* Simultaneously diagonalize X11 and X21. */ i__1 = *m - *q; i__2 = *m - *p; - dbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1], & work[iphi], &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &work[ib11d], &work[ ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e] , &work[ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, & childinfo); + dbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1], & work[iphi], (doublereal*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &work[ib11d], &work[ ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e] , &work[ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, & childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*q > r__) @@ -816,7 +829,7 @@ int dorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, /* Simultaneously diagonalize X11 and X21. */ i__1 = *m - *p; i__2 = *m - *q; - dbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1], & work[iphi], &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &work[ib11d], &work[ib11e], & work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + dbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1], & work[iphi], &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, (doublereal*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &work[ib11d], &work[ib11e], & work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*p > r__) diff --git a/src/map/lapack2flamec/f2c/flamec/front/dorghr.c b/src/map/lapack2flamec/f2c/flamec/front/dorghr.c index 38c19eab0..c432b4994 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/dorghr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/dorghr.c @@ -124,7 +124,7 @@ int dorghr_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, /* Local variables */ integer i__, j, nb, nh, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int lapack_dorgqr(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); @@ -190,7 +190,7 @@ int dorghr_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DORGHR", &i__1); + xerbla_("DORGHR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/front/dormhr.c b/src/map/lapack2flamec/f2c/flamec/front/dormhr.c index 559d57687..445a3d486 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/dormhr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/dormhr.c @@ -186,7 +186,7 @@ int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dormqr_fla(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -288,7 +288,7 @@ int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ if (*info != 0) { i__2 = -(*info); - xerbla_("DORMHR", &i__2); + xerbla_("DORMHR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/front/sopgtr.c b/src/map/lapack2flamec/f2c/flamec/front/sopgtr.c index 26bef5dde..95daea870 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/sopgtr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/sopgtr.c @@ -111,7 +111,7 @@ int sopgtr_(char *uplo, integer *n, real *ap, real *tau, real *q, integer *ldq, integer iinfo; logical upper; extern /* Subroutine */ - int sorg2l_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), xerbla_(char *, integer *); + int sorg2l_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), sorg2r_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer * ), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -158,7 +158,7 @@ int sopgtr_(char *uplo, integer *n, real *ap, real *tau, real *q, integer *ldq, if (*info != 0) { i__1 = -(*info); - xerbla_("SOPGTR", &i__1); + xerbla_("SOPGTR", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/front/sorcsd.c b/src/map/lapack2flamec/f2c/flamec/front/sorcsd.c index 442cf3d78..8744cb44a 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/sorcsd.c +++ b/src/map/lapack2flamec/f2c/flamec/front/sorcsd.c @@ -301,14 +301,14 @@ int sorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, logical defaultsigns; extern logical lsame_(char *, char *); real dummy[1]; - integer lbbcsdworkmin, itaup1, itaup2, itauq1, itauq2, lorbdbworkmin, lbbcsdworkopt; + integer lbbcsdworkmin, itaup1, itaup2, itauq1, itauq2, lbbcsdworkopt; logical wantu1, wantu2; integer ibbcsd, lorbdbworkopt; extern /* Subroutine */ int sbbcsd_(char *, char *, char *, char *, char * , integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, real *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *); integer iorbdb, lorglqworkmin, lorgqrworkmin; extern /* Subroutine */ - int sorbdb_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *), xerbla_(char *, integer *); + int sorbdb_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); integer lorglqworkopt, lorgqrworkopt; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); @@ -383,6 +383,23 @@ int sorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, colmajor = ! lsame_(trans, "T"); defaultsigns = ! lsame_(signs, "O"); lquery = *lwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + ibbcsd = 0; + itauq2 = 0; + itauq1 = 0; + itaup2 = 0; + itaup1 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -7; @@ -568,7 +585,6 @@ int sorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, iorbdb = itauq2 + fla_max(i__1,i__2); sorbdb_(trans, signs, m, p, q, &x11[x11_offset], ldx11, &x12[ x12_offset], ldx12, &x21[x21_offset], ldx21, &x22[x22_offset], ldx22, dummy, dummy, dummy, dummy, dummy, dummy, &work[1], & c_n1, &childinfo); lorbdbworkopt = (integer) work[1]; - lorbdbworkmin = lorbdbworkopt; /* Computing MAX */ i__1 = 1; i__2 = *m - *q; // , expr subst @@ -623,7 +639,7 @@ int sorcsd_(char *jobu1, char *jobu2, char *jobv1t, char * jobv2t, char *trans, if (*info != 0) { i__1 = -(*info); - xerbla_("SORCSD", &i__1); + xerbla_("SORCSD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/front/sorcsd2by1.c b/src/map/lapack2flamec/f2c/flamec/front/sorcsd2by1.c index b68c83a6e..297a0ef7f 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/sorcsd2by1.c +++ b/src/map/lapack2flamec/f2c/flamec/front/sorcsd2by1.c @@ -238,11 +238,9 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, integer itaup1, itaup2, itauq1; logical wantu1, wantu2; integer ibbcsd, lbbcsd; - extern /* Subroutine */ - int sbbcsd_(); integer iorbdb, lorbdb; extern /* Subroutine */ - int xerbla_(char *, integer *), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slacpy_( char *, integer *, integer *, real *, integer *, real *, integer * ); integer iorglq; extern /* Subroutine */ int slapmr_(logical *, integer *, integer *, real *, integer *, integer *); @@ -255,7 +253,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, sorgqr_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); logical lquery; extern /* Subroutine */ - int sorbdb1_(), sorbdb2_(), sorbdb3_(), sorbdb4_() ; + int sbbcsd_(char *, char *, char *, char *, char *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *), sorbdb1_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *, integer *, integer *), sorbdb2_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *, integer *, integer *), sorbdb3_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *, integer *, integer *), sorbdb4_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, real *, real *, integer *, integer *); logical wantv1t; /* -- LAPACK computational routine (version 3.5.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -303,6 +301,21 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, wantu2 = lsame_(jobu2, "Y"); wantv1t = lsame_(jobv1t, "Y"); lquery = *lwork == -1; + iorgqr = 0; + iorglq = 0; + iorbdb = 0; + ibbcsd = 0; + itauq1 = 0; + itaup2 = 0; + itaup1 = 0; + ib22e = 0; + ib22d = 0; + ib21e = 0; + ib21d = 0; + ib12e = 0; + ib12d = 0; + ib11e = 0; + ib11d = 0; if (*m < 0) { *info = -4; @@ -404,7 +417,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, iorglq = itauq1 + fla_max(1,*q); if (r__ == *q) { - sorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + sorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p >= *m - *p) { @@ -441,12 +454,12 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, i__2 = *q - 1; // , expr subst lorglqmin = fla_max(i__1,i__2); lorglqopt = (integer) work[1]; - sbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &c__0, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo); + sbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], (real*)&c__0, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, (real*)&c__0, &c__1, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], &c_n1, & childinfo); lbbcsd = (integer) work[1]; } else if (r__ == *p) { - sorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + sorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p - 1 >= *m - *p) { @@ -474,12 +487,12 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, (real*)&c__0, &work[1], & c_n1, &childinfo); lorglqmin = fla_max(1,*q); lorglqopt = (integer) work[1]; - sbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &c__0, &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &c__0, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo); + sbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], (real*)&c__0, &v1t[v1t_offset], ldv1t, (real*)&c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], &c_n1, &childinfo); lbbcsd = (integer) work[1]; } else if (r__ == *m - *p) { - sorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo); + sorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], & c_n1, &childinfo); lorbdb = (integer) work[1]; if (*p >= *m - *p - 1) { @@ -504,12 +517,12 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, lorglqopt = (integer) work[1]; i__1 = *m - *q; i__2 = *m - *p; - sbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1] , &c__0, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo); + sbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1] , (real*)&c__0, (real*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], &c_n1, &childinfo); lbbcsd = (integer) work[1]; } else { - sorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &c__0, & work[1], &c_n1, &childinfo); + sorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, & work[1], &c_n1, &childinfo); lorbdb = *m + (integer) work[1]; if (*p >= *m - *p) { @@ -535,7 +548,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, lorglqopt = (integer) work[1]; i__1 = *m - *p; i__2 = *m - *q; - sbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1] , &c__0, &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, & c__0, &c__1, &v1t[v1t_offset], ldv1t, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo); + sbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1] , (real*)&c__0, &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, (real*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, (real*)&c__0, &work[1], &c_n1, & childinfo); lbbcsd = (integer) work[1]; } /* Computing MAX */ @@ -557,7 +570,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, if (*info != 0) { i__1 = -(*info); - xerbla_("SORCSD2BY1", &i__1); + xerbla_("SORCSD2BY1", &i__1, (ftnlen)10); return 0; } else if (lquery) @@ -607,7 +620,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, sorglq_fla(&i__1, &i__2, &i__3, &v1t[(v1t_dim1 << 1) + 2], ldv1t, & work[itauq1], &work[iorglq], &lorglq, &childinfo); } /* Simultaneously diagonalize X11 and X21. */ - sbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &work[ iphi], &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &work[ib11d], &work[ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + sbbcsd_(jobu1, jobu2, jobv1t, "N", "N", m, p, q, &theta[1], &work[ iphi], &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, (real*)&c__0, &c__1, &work[ib11d], &work[ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place zero submatrices in */ /* preferred positions */ if (*q > 0 && wantu2) @@ -670,7 +683,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, &work[itauq1], &work[ iorglq], &lorglq, &childinfo); } /* Simultaneously diagonalize X11 and X21. */ - sbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &work[ iphi], &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &work[ib11d], &work[ib11e], &work[ ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ib22d] , &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + sbbcsd_(jobv1t, "N", jobu1, jobu2, "T", m, q, p, &theta[1], &work[ iphi], &v1t[v1t_offset], ldv1t, (real*)&c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &work[ib11d], &work[ib11e], &work[ ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ib22d] , &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*q > 0 && wantu2) @@ -733,7 +746,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, /* Simultaneously diagonalize X11 and X21. */ i__1 = *m - *q; i__2 = *m - *p; - sbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1], & work[iphi], &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &work[ib11d], &work[ ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e] , &work[ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, & childinfo); + sbbcsd_("N", jobv1t, jobu2, jobu1, "T", m, &i__1, &i__2, &theta[1], & work[iphi], (real*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &work[ib11d], &work[ ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e] , &work[ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, & childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*q > r__) @@ -819,7 +832,7 @@ int sorcsd2by1_(char *jobu1, char *jobu2, char *jobv1t, integer *m, integer *p, /* Simultaneously diagonalize X11 and X21. */ i__1 = *m - *p; i__2 = *m - *q; - sbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1], & work[iphi], &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &work[ib11d], &work[ib11e], & work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); + sbbcsd_(jobu2, jobu1, "N", jobv1t, "N", m, &i__1, &i__2, &theta[1], & work[iphi], &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, (real*)&c__0, &c__1, &v1t[v1t_offset], ldv1t, &work[ib11d], &work[ib11e], & work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo); /* Permute rows and columns to place identity submatrices in */ /* preferred positions */ if (*p > r__) diff --git a/src/map/lapack2flamec/f2c/flamec/front/sorghr.c b/src/map/lapack2flamec/f2c/flamec/front/sorghr.c index 685c51479..5a04b613b 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/sorghr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/sorghr.c @@ -124,7 +124,7 @@ int sorghr_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real /* Local variables */ integer i__, j, nb, nh, iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sorgqr_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); @@ -190,7 +190,7 @@ int sorghr_(integer *n, integer *ilo, integer *ihi, real *a, integer *lda, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORGHR", &i__1); + xerbla_("SORGHR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/front/sormhr.c b/src/map/lapack2flamec/f2c/flamec/front/sormhr.c index 01ef15ae5..19921c007 100644 --- a/src/map/lapack2flamec/f2c/flamec/front/sormhr.c +++ b/src/map/lapack2flamec/f2c/flamec/front/sormhr.c @@ -187,7 +187,7 @@ int sormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ extern logical lsame_(char *, char *); integer iinfo; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -289,7 +289,7 @@ int sormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integ if (*info != 0) { i__2 = -(*info); - xerbla_("SORMHR", &i__2); + xerbla_("SORMHR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/cungl2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/cungl2_fla.c index c19c713e3..d4791b61c 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/cungl2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/cungl2_fla.c @@ -109,7 +109,7 @@ int cungl2_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,7 +156,7 @@ int cungl2_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGL2", &i__1); + xerbla_("CUNGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/cunglq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/cunglq_fla.c index 32d94d943..39c6ce39b 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/cunglq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/cunglq_fla.c @@ -127,7 +127,7 @@ int cunglq_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cungl2_fla(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cungl2_fla(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -188,7 +188,7 @@ int cunglq_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGLQ", &i__1); + xerbla_("CUNGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/cunml2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/cunml2_fla.c index 4366cb883..4411d84c9 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/cunml2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/cunml2_fla.c @@ -161,7 +161,7 @@ int cunml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp int clarf_(char *, integer *, integer *, complex * , integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); + int clacgv_(integer *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -237,7 +237,7 @@ int cunml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNML2", &i__1); + xerbla_("CUNML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/cunmlq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/cunmlq_fla.c index bf86440a5..9620a1669 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/cunmlq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/cunmlq_fla.c @@ -182,7 +182,7 @@ int cunmlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunml2_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); + int cunml2_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -284,7 +284,7 @@ int cunmlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMLQ", &i__1); + xerbla_("CUNMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/dorgl2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/dorgl2_fla.c index f25a11c49..b3911e52f 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/dorgl2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/dorgl2_fla.c @@ -107,7 +107,7 @@ int dorgl2_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int dorgl2_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DORGL2", &i__1); + xerbla_("DORGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/dorglq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/dorglq_fla.c index 8f96b9783..4b699ca25 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/dorglq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/dorglq_fla.c @@ -126,7 +126,7 @@ int dorglq_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int dorgl2_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorgl2_fla(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -186,7 +186,7 @@ int dorglq_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, if (*info != 0) { i__1 = -(*info); - xerbla_("DORGLQ", &i__1); + xerbla_("DORGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/dorml2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/dorml2_fla.c index 6df20ff6f..edbcb9a7f 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/dorml2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/dorml2_fla.c @@ -157,7 +157,7 @@ int dorml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -233,7 +233,7 @@ int dorml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DORML2", &i__1); + xerbla_("DORML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/dormlq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/dormlq_fla.c index 94b8a5a56..66f91a751 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/dormlq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/dormlq_fla.c @@ -181,7 +181,7 @@ int dormlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int dorml2_fla(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dorml2_fla(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *), dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork; @@ -282,7 +282,7 @@ int dormlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DORMLQ", &i__1); + xerbla_("DORMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/sorgl2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/sorgl2_fla.c index 3e6f1ec65..ff3e71b9f 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/sorgl2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/sorgl2_fla.c @@ -107,7 +107,7 @@ int sorgl2_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -154,7 +154,7 @@ int sorgl2_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SORGL2", &i__1); + xerbla_("SORGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/sorglq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/sorglq_fla.c index 57ee673cf..cbd0a3ac5 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/sorglq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/sorglq_fla.c @@ -126,7 +126,7 @@ int sorglq_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sorgl2_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorgl2_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -188,7 +188,7 @@ int sorglq_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SORGLQ", &i__1); + xerbla_("SORGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/sorml2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/sorml2_fla.c index 1654d9a25..0482496a4 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/sorml2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/sorml2_fla.c @@ -155,7 +155,7 @@ int sorml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, real logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -231,7 +231,7 @@ int sorml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORML2", &i__1); + xerbla_("SORML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/sormlq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/sormlq_fla.c index db4e25c6c..eea43735c 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/sormlq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/sormlq_fla.c @@ -182,7 +182,7 @@ int sormlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, real extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int sorml2_fla(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char * , integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorml2_fla(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *), slarfb_(char *, char *, char *, char * , integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -285,7 +285,7 @@ int sormlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORMLQ", &i__1); + xerbla_("SORMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/zungl2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/zungl2_fla.c index b94e4eab4..426bbc4dd 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/zungl2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/zungl2_fla.c @@ -109,7 +109,7 @@ int zungl2_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -156,7 +156,7 @@ int zungl2_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGL2", &i__1); + xerbla_("ZUNGL2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/zunglq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/zunglq_fla.c index 6634d9274..4bf14a689 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/zunglq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/zunglq_fla.c @@ -127,7 +127,7 @@ int zunglq_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zungl2_fla(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zungl2_fla(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -193,7 +193,7 @@ int zunglq_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGLQ", &i__1); + xerbla_("ZUNGLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/zunml2_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/zunml2_fla.c index 66e01b7ae..acc5e3cde 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/zunml2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/zunml2_fla.c @@ -159,7 +159,7 @@ int zunml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlacgv_(integer *, doublecomplex *, integer *); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -235,7 +235,7 @@ int zunml2_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNML2", &i__1); + xerbla_("ZUNML2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/gelq/zunmlq_fla.c b/src/map/lapack2flamec/f2c/flamec/gelq/zunmlq_fla.c index 403e41118..5530fee28 100644 --- a/src/map/lapack2flamec/f2c/flamec/gelq/zunmlq_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/gelq/zunmlq_fla.c @@ -181,7 +181,7 @@ int zunmlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunml2_fla(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunml2_fla(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -287,7 +287,7 @@ int zunmlq_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMLQ", &i__1); + xerbla_("ZUNMLQ", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/cung2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/cung2r_fla.c index e225a02d6..b653e1fc0 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/cung2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/cung2r_fla.c @@ -110,7 +110,7 @@ int cung2r_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int cscal_(integer *, complex *, complex *, integer *), clarf_(char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -157,7 +157,7 @@ int cung2r_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com if (*info != 0) { i__1 = -(*info); - xerbla_("CUNG2R", &i__1); + xerbla_("CUNG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/cungqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/cungqr_fla.c index 4af49d9a0..f23e52d66 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/cungqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/cungqr_fla.c @@ -127,7 +127,7 @@ int cungqr_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int cung2r_fla(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(char *, integer *); + int cung2r_fla(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_( char *, char *, integer *, integer *, complex *, integer *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -188,7 +188,7 @@ int cungqr_fla(integer *m, integer *n, integer *k, complex *a, integer *lda, com if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGQR", &i__1); + xerbla_("CUNGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/cunm2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/cunm2r_fla.c index 7be173275..be3d5b9da 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/cunm2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/cunm2r_fla.c @@ -164,7 +164,7 @@ int cunm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp int clarf_(char *, integer *, integer *, complex * , integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -240,7 +240,7 @@ int cunm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNM2R", &i__1); + xerbla_("CUNM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/cunmqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/cunmqr_fla.c index 447affa42..4b0a7b5f4 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/cunmqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/cunmqr_fla.c @@ -183,7 +183,7 @@ int cunmqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int cunm2r_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); + int cunm2r_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -283,7 +283,7 @@ int cunmqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, comp if (*info != 0) { i__1 = -(*info); - xerbla_("CUNMQR", &i__1); + xerbla_("CUNMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqp3_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqp3_fla.c index 555712f0e..092e5600e 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqp3_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqp3_fla.c @@ -156,7 +156,7 @@ int dgeqp3_fla(integer *m, integer *n, doublereal *a, integer * lda, integer *jp int dswap_(integer *, doublereal *, integer *, doublereal *, integer *); integer minws; extern /* Subroutine */ - int dlaqp2_(integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(char *, integer *); + int dlaqp2_(integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *), dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dlaqps_(integer *, integer *, integer *, integer *, integer *, doublereal *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, integer *); @@ -236,7 +236,7 @@ int dgeqp3_fla(integer *m, integer *n, doublereal *a, integer * lda, integer *jp if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQP3", &i__1); + xerbla_("DGEQP3", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqpf_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqpf_fla.c index f49a73710..136114fa3 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqpf_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqpf_fla.c @@ -156,7 +156,7 @@ int dgeqpf_fla(integer *m, integer *n, doublereal *a, integer * lda, integer *jp int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -201,7 +201,7 @@ int dgeqpf_fla(integer *m, integer *n, doublereal *a, integer * lda, integer *jp if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQPF", &i__1); + xerbla_("DGEQPF", &i__1, (ftnlen)6); return 0; } mn = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2_fla.c index f0edef955..0023ce7a0 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2_fla.c @@ -126,7 +126,7 @@ /* Local variables */ integer i__, k; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal aii; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -165,7 +165,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQR2", &i__1); + xerbla_("DGEQR2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2p_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2p_fla.c index a69f1679c..52bafa1f2 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2p_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqr2p_fla.c @@ -130,7 +130,7 @@ /* Local variables */ integer i__, k; extern /* Subroutine */ - int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); doublereal aii; extern /* Subroutine */ int dlarfgp_(integer *, doublereal *, doublereal * , integer *, doublereal *); @@ -171,7 +171,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQR2P", &i__1); + xerbla_("DGEQR2P", &i__1, (ftnlen)7); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrf_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrf_fla.c index f14e33018..e5745734f 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrf_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrf_fla.c @@ -160,7 +160,7 @@ extern int fla_dgeqrf_small(integer *m, integer *n, int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer nx; extern /* Subroutine */ - int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -217,7 +217,7 @@ extern int fla_dgeqrf_small(integer *m, integer *n, } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRF", &i__1); + xerbla_("DGEQRF", &i__1, (ftnlen)6); return 0; } else if (lquery) { @@ -233,7 +233,7 @@ extern int fla_dgeqrf_small(integer *m, integer *n, nx = 0; iws = *n; #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -284,8 +284,8 @@ extern int fla_dgeqrf_small(integer *m, integer *n, #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=ib; - AOCL_FLA_PROGRESS_FUNC_PTR("DGEQRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=ib; + AOCL_FLA_PROGRESS_FUNC_PTR("DGEQRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -315,8 +315,8 @@ extern int fla_dgeqrf_small(integer *m, integer *n, #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count=k; - AOCL_FLA_PROGRESS_FUNC_PTR("DGEQRF",6,&step_count,&thread_id,&total_threads); + progress_step_count=k; + AOCL_FLA_PROGRESS_FUNC_PTR("DGEQRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrfp_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrfp_fla.c index eba065563..35f36bdf8 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrfp_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dgeqrfp_fla.c @@ -152,7 +152,7 @@ int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer nx; extern /* Subroutine */ - int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -203,7 +203,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DGEQRFP", &i__1); + xerbla_("DGEQRFP", &i__1, (ftnlen)7); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dorg2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dorg2r_fla.c index 11e81e9fd..e1299f89e 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dorg2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dorg2r_fla.c @@ -1,7 +1,11 @@ /* ../netlib/dorg2r.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ -#include "FLA_f2c.h" /* Table of constant values */ +/* + Modifications Copyright (c) 2023 Advanced Micro Devices, Inc. All rights reserved. +*/ + +#include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; /* > \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by s geqrf (unblocked algorithm). */ /* =========== DOCUMENTATION =========== */ @@ -113,7 +117,7 @@ int dorg2r_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, /* Initialize global context data */ aocl_fla_init(); -#ifdef FLA_ENABLE_AMD_OPT +#if FLA_ENABLE_AMD_OPT if (global_context.is_avx2) { retval = dorg2r_fla_opt(m, n, k, a, lda, tau, work, info); @@ -129,17 +133,16 @@ int dorg2r_fla(integer *m, integer *n, integer *k, doublereal * a, integer *lda, return retval; } +#if FLA_ENABLE_AMD_OPT int dorg2r_fla_opt(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; doublereal d__1; - integer i; - doublereal *dx; /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int fla_dscal(integer *, doublereal *, doublereal *, integer *), dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* Test the input arguments */ /* Parameter adjustments */ a_dim1 = *lda; @@ -168,7 +171,7 @@ int dorg2r_fla_opt(integer *m, integer *n, integer *k, doublereal * a, integer * if (*info != 0) { i__1 = -(*info); - xerbla_("DORG2R", &i__1); + xerbla_("DORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ @@ -213,7 +216,7 @@ int dorg2r_fla_opt(integer *m, integer *n, integer *k, doublereal * a, integer * if (i__ < *m) { - fla_dscal(&i__1, &d__1, &a[i__ + 1 + i__ * a_dim1], &c__1); + fla_dscal(&i__1, &d__1, &a[i__ + 1 + i__ * a_dim1], &c__1); } else { @@ -235,6 +238,7 @@ int dorg2r_fla_opt(integer *m, integer *n, integer *k, doublereal * a, integer * return 0; /* End of DORG2R */ } +#endif int dorg2r_fla_native(integer *m, integer *n, integer *k, doublereal * a, integer *lda, doublereal *tau, doublereal *work, integer *info) { @@ -244,7 +248,7 @@ int dorg2r_fla_native(integer *m, integer *n, integer *k, doublereal * a, intege /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); + int dscal_(integer *, doublereal *, doublereal *, integer *), dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -291,7 +295,7 @@ int dorg2r_fla_native(integer *m, integer *n, integer *k, doublereal * a, intege if (*info != 0) { i__1 = -(*info); - xerbla_("DORG2R", &i__1); + xerbla_("DORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dorm2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dorm2r_fla.c index c20181f16..21f6238fe 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dorm2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dorm2r_fla.c @@ -160,7 +160,7 @@ int dorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *); extern logical lsame_(char *, char *); extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -236,7 +236,7 @@ int dorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("DORM2R", &i__1); + xerbla_("DORM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dormbr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dormbr_fla.c index b1f5c4b93..13585774c 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dormbr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dormbr_fla.c @@ -2,7 +2,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; - static integer c__2 = 2; /* > \brief \b DORMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -192,8 +191,7 @@ /* Subroutine */ int dormbr_fla(char *vect, char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -203,7 +201,7 @@ extern logical lsame_(char *, char *); integer iinfo, i1, i2, nb, mi, ni, nq, nw; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dormlq_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -318,7 +316,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORMBR", &i__1); + xerbla_("DORMBR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/dormqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/dormqr_fla.c index 5b1e14ef1..5dace5ea5 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/dormqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/dormqr_fla.c @@ -180,7 +180,7 @@ int dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *); integer nq, nw; extern /* Subroutine */ - int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dlarft_(char *, char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran; integer ldwork, lwkopt; @@ -263,7 +263,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("DORMQR", &i__1); + xerbla_("DORMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqp3_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqp3_fla.c index 69866dd25..9516c1d68 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqp3_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqp3_fla.c @@ -153,7 +153,7 @@ int sgeqp3_fla(integer *m, integer *n, real *a, integer *lda, integer *jpvt, rea extern real snrm2_(integer *, real *, integer *); integer nbmin, minmn, minws; extern /* Subroutine */ - int sswap_(integer *, real *, integer *, real *, integer *), slaqp2_(integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, real *), xerbla_( char *, integer *); + int sswap_(integer *, real *, integer *, real *, integer *), slaqp2_(integer *, integer *, integer *, real *, integer *, integer *, real *, real *, real *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *); @@ -229,7 +229,7 @@ int sgeqp3_fla(integer *m, integer *n, real *a, integer *lda, integer *jpvt, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQP3", &i__1); + xerbla_("SGEQP3", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqpf_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqpf_fla.c index cdd5becca..c62af9d0e 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqpf_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqpf_fla.c @@ -153,7 +153,7 @@ int sgeqpf_fla(integer *m, integer *n, real *a, integer *lda, integer *jpvt, rea int sswap_(integer *, real *, integer *, real *, integer *), sgeqr2_(integer *, integer *, real *, integer *, real *, real *, integer *), sorm2r_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *); extern real slamch_(char *); extern /* Subroutine */ - int xerbla_(char *, integer *), slarfg_( integer *, real *, real *, integer *, real *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_( integer *, real *, real *, integer *, real *); extern integer isamax_(integer *, real *, integer *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -199,7 +199,7 @@ int sgeqpf_fla(integer *m, integer *n, real *a, integer *lda, integer *jpvt, rea if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQPF", &i__1); + xerbla_("SGEQPF", &i__1, (ftnlen)6); return 0; } mn = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2_fla.c index 07a6e76fb..a248e34a0 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2_fla.c @@ -126,7 +126,7 @@ /* Local variables */ integer i__, k; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); real aii; /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -165,7 +165,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQR2", &i__1); + xerbla_("SGEQR2", &i__1, (ftnlen)6); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2p_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2p_fla.c index 259288598..6f3fec013 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2p_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqr2p_fla.c @@ -130,7 +130,7 @@ /* Local variables */ integer i__, k; extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); real aii; extern /* Subroutine */ int slarfgp_(integer *, real *, real *, integer *, real *); @@ -171,7 +171,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQR2P", &i__1); + xerbla_("SGEQR2P", &i__1, (ftnlen)7); return 0; } k = fla_min(*m,*n); diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrf_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrf_fla.c index 18146d122..357990a86 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrf_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrf_fla.c @@ -148,7 +148,7 @@ int sgeqr2_fla(integer *, integer *, real *, integer *, real *, real *, integer *); integer ib, nb, nx; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -203,7 +203,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRF", &i__1); + xerbla_("SGEQRF", &i__1, (ftnlen)6); return 0; } else if (lquery) { @@ -220,7 +220,7 @@ iws = *n; #if AOCL_FLA_PROGRESS_H - step_count =0; + progress_step_count =0; #ifndef FLA_ENABLE_WINDOWS_BUILD if(!aocl_fla_progress_ptr) aocl_fla_progress_ptr=aocl_fla_progress; @@ -262,8 +262,8 @@ #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count+=ib; - AOCL_FLA_PROGRESS_FUNC_PTR("SGEQRF",6,&step_count,&thread_id,&total_threads); + progress_step_count+=ib; + AOCL_FLA_PROGRESS_FUNC_PTR("SGEQRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif @@ -293,8 +293,8 @@ #if AOCL_FLA_PROGRESS_H if(aocl_fla_progress_ptr){ - step_count=k; - AOCL_FLA_PROGRESS_FUNC_PTR("SGEQRF",6,&step_count,&thread_id,&total_threads); + progress_step_count=k; + AOCL_FLA_PROGRESS_FUNC_PTR("SGEQRF",6,&progress_step_count,&progress_thread_id,&progress_total_threads); } #endif diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrfp_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrfp_fla.c index ab3ee1119..35a34174c 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrfp_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sgeqrfp_fla.c @@ -149,7 +149,7 @@ /* Local variables */ integer i__, k, nbmin, iinfo, ib, nb, nx; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -202,7 +202,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SGEQRFP", &i__1); + xerbla_("SGEQRFP", &i__1, (ftnlen)7); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sorg2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sorg2r_fla.c index 0860a5bf1..41394f8ab 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sorg2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sorg2r_fla.c @@ -110,7 +110,7 @@ int sorg2r_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(char *, integer *); + int sscal_(integer *, real *, real *, integer *), slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -157,7 +157,7 @@ int sorg2r_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SORG2R", &i__1); + xerbla_("SORG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sorgqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sorgqr_fla.c index d186a1571..eacfc5a4c 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sorgqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sorgqr_fla.c @@ -127,7 +127,7 @@ int sorgqr_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int sorg2r_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int sorg2r_fla(integer *, integer *, integer *, real *, integer *, real *, real *, integer *), slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -189,7 +189,7 @@ int sorgqr_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real * if (*info != 0) { i__1 = -(*info); - xerbla_("SORGQR", &i__1); + xerbla_("SORGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sorm2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sorm2r_fla.c index f7a0f4573..56932e33b 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sorm2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sorm2r_fla.c @@ -158,7 +158,7 @@ int sorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, real logical left; extern logical lsame_(char *, char *); extern /* Subroutine */ - int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_( char *, integer *); + int slarf_(char *, integer *, integer *, real *, integer *, real *, real *, integer *, real *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -234,7 +234,7 @@ int sorm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, real if (*info != 0) { i__1 = -(*info); - xerbla_("SORM2R", &i__1); + xerbla_("SORM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sormbr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sormbr_fla.c index 586f25033..1eb48ffc7 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sormbr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sormbr_fla.c @@ -2,7 +2,6 @@ #include "FLA_f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c_n1 = -1; - static integer c__2 = 2; /* > \brief \b SORMBR */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ @@ -193,8 +192,7 @@ /* Subroutine */ int sormbr_fla(char *vect, char *side, char *trans, integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc, real *work, integer *lwork, integer *info) { /* System generated locals */ - address a__1[2]; - integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2]; + integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2; char ch__1[2]; /* Builtin functions */ /* Subroutine */ @@ -204,7 +202,7 @@ extern logical lsame_(char *, char *); integer iinfo, i1, i2, nb, mi, ni, nq, nw; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical notran, applyq; char transt[1]; @@ -213,7 +211,7 @@ integer lwkopt; logical lquery; extern /* Subroutine */ - int sormqr_fla(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *); + int sormqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *); /* -- LAPACK computational routine -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -318,7 +316,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SORMBR", &i__1); + xerbla_("SORMBR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/sormqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/sormqr_fla.c index 6866afe64..5ad5f5f2b 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/sormqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/sormqr_fla.c @@ -178,7 +178,7 @@ int sorm2r_fla(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *); integer mi, ni, nq, nw; extern /* Subroutine */ - int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(char *, integer *); + int slarfb_(char *, char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slarft_(char *, char *, integer *, integer *, real *, integer *, real *, real *, integer *); @@ -263,7 +263,7 @@ } if (*info != 0) { i__1 = -(*info); - xerbla_("SORMQR", &i__1); + xerbla_("SORMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) { diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/zung2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/zung2r_fla.c index e59f7ede0..502777e4b 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/zung2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/zung2r_fla.c @@ -110,7 +110,7 @@ int zung2r_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld /* Local variables */ integer i__, j, l; extern /* Subroutine */ - int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.0) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -157,7 +157,7 @@ int zung2r_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNG2R", &i__1); + xerbla_("ZUNG2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/zungqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/zungqr_fla.c index df62700b7..b46631fc2 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/zungqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/zungqr_fla.c @@ -127,7 +127,7 @@ int zungqr_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld /* Local variables */ integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ - int zung2r_fla(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zung2r_fla(integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -193,7 +193,7 @@ int zungqr_fla(integer *m, integer *n, integer *k, doublecomplex *a, integer *ld if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGQR", &i__1); + xerbla_("ZUNGQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/zunm2r_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/zunm2r_fla.c index 5e9ccc266..80876c18d 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/zunm2r_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/zunm2r_fla.c @@ -162,7 +162,7 @@ int zunm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub doublecomplex taui; extern logical lsame_(char *, char *); extern /* Subroutine */ - int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(char *, integer *); + int zlarf_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); logical notran; /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ @@ -238,7 +238,7 @@ int zunm2r_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNM2R", &i__1); + xerbla_("ZUNM2R", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/geqr/zunmqr_fla.c b/src/map/lapack2flamec/f2c/flamec/geqr/zunmqr_fla.c index 919a836a1..282f4cd58 100644 --- a/src/map/lapack2flamec/f2c/flamec/geqr/zunmqr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/geqr/zunmqr_fla.c @@ -182,7 +182,7 @@ int zunmqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub extern logical lsame_(char *, char *); integer nbmin, iinfo; extern /* Subroutine */ - int zunm2r_fla(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zunm2r_fla(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); @@ -287,7 +287,7 @@ int zunmqr_fla(char *side, char *trans, integer *m, integer *n, integer *k, doub if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNMQR", &i__1); + xerbla_("ZUNMQR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hegs/CMakeLists.txt b/src/map/lapack2flamec/f2c/flamec/hegs/CMakeLists.txt new file mode 100644 index 000000000..26d055c7d --- /dev/null +++ b/src/map/lapack2flamec/f2c/flamec/hegs/CMakeLists.txt @@ -0,0 +1,8 @@ +##Copyright (C) 2023, Advanced Micro Devices, Inc.## +target_sources("${PROJECT_NAME}" + PRIVATE +${CMAKE_CURRENT_SOURCE_DIR}/chegs2_fla.c +${CMAKE_CURRENT_SOURCE_DIR}/chegst_fla.c +${CMAKE_CURRENT_SOURCE_DIR}/zhegs2_fla.c +${CMAKE_CURRENT_SOURCE_DIR}/zhegst_fla.c + ) \ No newline at end of file diff --git a/src/map/lapack2flamec/f2c/flamec/hegs/chegs2_fla.c b/src/map/lapack2flamec/f2c/flamec/hegs/chegs2_fla.c new file mode 100644 index 000000000..0121a72b9 --- /dev/null +++ b/src/map/lapack2flamec/f2c/flamec/hegs/chegs2_fla.c @@ -0,0 +1,375 @@ +/* chegs2.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ +#include "FLA_f2c.h" /* Table of constant values */ +static complex c_b1 = +{ + 1.f,0.f +} +; +static integer c__1 = 1; +/* > \brief \b CHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factor ization results obtained from cpotrf (unblocked algorithm). */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* > \htmlonly */ +/* > Download CHEGS2 + dependencies */ +/* > */ +/* > [TGZ] */ +/* > */ +/* > [ZIP] */ +/* > */ +/* > [TXT] */ +/* > \endhtmlonly */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) */ +/* .. Scalar Arguments .. */ +/* CHARACTER UPLO */ +/* INTEGER INFO, ITYPE, LDA, LDB, N */ +/* .. */ +/* .. Array Arguments .. */ +/* COMPLEX A( LDA, * ), B( LDB, * ) */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > CHEGS2 reduces a complex Hermitian-definite generalized */ +/* > eigenproblem to standard form. */ +/* > */ +/* > If ITYPE = 1, the problem is A*x = lambda*B*x, */ +/* > and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H) */ +/* > */ +/* > If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or */ +/* > B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H *A*L. */ +/* > */ +/* > B must have been previously factorized as U**H *U or L*L**H by ZPOTRF. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] ITYPE */ +/* > \verbatim */ +/* > ITYPE is INTEGER */ +/* > = 1: compute inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H); +*/ +/* > = 2 or 3: compute U*A*U**H or L**H *A*L. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] UPLO */ +/* > \verbatim */ +/* > UPLO is CHARACTER*1 */ +/* > Specifies whether the upper or lower triangular part of the */ +/* > Hermitian matrix A is stored, and how B has been factorized. */ +/* > = 'U': Upper triangular */ +/* > = 'L': Lower triangular */ +/* > \endverbatim */ +/* > */ +/* > \param[in] N */ +/* > \verbatim */ +/* > N is INTEGER */ +/* > The order of the matrices A and B. N >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] A */ +/* > \verbatim */ +/* > A is COMPLEX array, dimension (LDA,N) */ +/* > On entry, the Hermitian matrix A. If UPLO = 'U', the leading */ +/* > n by n upper triangular part of A contains the upper */ +/* > triangular part of the matrix A, and the strictly lower */ +/* > triangular part of A is not referenced. If UPLO = 'L', the */ +/* > leading n by n lower triangular part of A contains the lower */ +/* > triangular part of the matrix A, and the strictly upper */ +/* > triangular part of A is not referenced. */ +/* > */ +/* > On exit, if INFO = 0, the transformed matrix, stored in the */ +/* > same format as A. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDA */ +/* > \verbatim */ +/* > LDA is INTEGER */ +/* > The leading dimension of the array A. LDA >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] B */ +/* > \verbatim */ +/* > B is COMPLEX array, dimension (LDB,N) */ +/* > The triangular factor from the Cholesky factorization of B, */ +/* > as returned by CPOTRF. */ +/* > B is modified by the routine but restored on exit. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDB */ +/* > \verbatim */ +/* > LDB is INTEGER */ +/* > The leading dimension of the array B. LDB >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] INFO */ +/* > \verbatim */ +/* > INFO is INTEGER */ +/* > = 0: successful exit. */ +/* > < 0: if INFO = -i, the i-th argument had an illegal value. */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Univ. of Tennessee */ +/* > \author Univ. of California Berkeley */ +/* > \author Univ. of Colorado Denver */ +/* > \author NAG Ltd. */ +/* > \ingroup complexHEcomputational */ +/* ===================================================================== */ +/* Subroutine */ +int chegs2_fla(integer *itype, char *uplo, integer *n, complex * a, integer *lda, complex *b, integer *ldb, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2; + real r__1, r__2; + complex q__1; + /* Local variables */ + integer k; + complex ct; + real akk, bkk; + extern /* Subroutine */ + int cher2_(char *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, integer *); + extern logical lsame_(char *, char *); + extern /* Subroutine */ + int caxpy_(integer *, complex *, complex *, integer *, complex *, integer *); + logical upper; + extern /* Subroutine */ + int ctrmv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), ctrsv_(char *, char *, char *, integer *, complex *, integer *, complex *, integer *), clacgv_( integer *, complex *, integer *), csscal_(integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); + /* -- LAPACK computational routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* .. Scalar Arguments .. */ + /* .. */ + /* .. Array Arguments .. */ + /* .. */ + /* ===================================================================== */ + /* .. Parameters .. */ + /* .. */ + /* .. Local Scalars .. */ + /* .. */ + /* .. External Subroutines .. */ + /* .. */ + /* .. Intrinsic Functions .. */ + /* .. */ + /* .. External Functions .. */ + /* .. */ + /* .. Executable Statements .. */ + /* Test the input parameters. */ + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1; + b -= b_offset; + /* Function Body */ + *info = 0; + upper = lsame_(uplo, "U"); + if (*itype < 1 || *itype > 3) + { + *info = -1; + } + else if (! upper && ! lsame_(uplo, "L")) + { + *info = -2; + } + else if (*n < 0) + { + *info = -3; + } + else if (*lda < fla_max(1,*n)) + { + *info = -5; + } + else if (*ldb < fla_max(1,*n)) + { + *info = -7; + } + if (*info != 0) + { + i__1 = -(*info); + xerbla_("CHEGS2", &i__1, (ftnlen)6); + return 0; + } + if (*itype == 1) + { + if (upper) + { + /* Compute inv(U**H)*A*inv(U) */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the upper triangle of A(k:n,k:n) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + /* Computing 2nd power */ + r__1 = bkk; + akk /= r__1 * r__1; + i__2 = k + k * a_dim1; + a[i__2].r = akk; + a[i__2].i = 0.f; // , expr subst + if (k < *n) + { + i__2 = *n - k; + r__1 = 1.f / bkk; + csscal_(&i__2, &r__1, &a[k + (k + 1) * a_dim1], lda); + r__1 = akk * -.5f; + ct.r = r__1; + ct.i = 0.f; // , expr subst + i__2 = *n - k; + clacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda); + i__2 = *n - k; + clacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb); + i__2 = *n - k; + caxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + ( k + 1) * a_dim1], lda); + i__2 = *n - k; + q__1.r = -1.f; + q__1.i = -0.f; // , expr subst + cher2_(uplo, &i__2, &q__1, &a[k + (k + 1) * a_dim1], lda, &b[k + (k + 1) * b_dim1], ldb, &a[k + 1 + (k + 1) * a_dim1], lda); + i__2 = *n - k; + caxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + ( k + 1) * a_dim1], lda); + i__2 = *n - k; + clacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb); + i__2 = *n - k; + ctrsv_(uplo, "Conjugate transpose", "Non-unit", &i__2, &b[ k + 1 + (k + 1) * b_dim1], ldb, &a[k + (k + 1) * a_dim1], lda); + i__2 = *n - k; + clacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda); + } + /* L10: */ + } + } + else + { + /* Compute inv(L)*A*inv(L**H) */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the lower triangle of A(k:n,k:n) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + /* Computing 2nd power */ + r__1 = bkk; + akk /= r__1 * r__1; + i__2 = k + k * a_dim1; + a[i__2].r = akk; + a[i__2].i = 0.f; // , expr subst + if (k < *n) + { + i__2 = *n - k; + r__1 = 1.f / bkk; + csscal_(&i__2, &r__1, &a[k + 1 + k * a_dim1], &c__1); + r__1 = akk * -.5f; + ct.r = r__1; + ct.i = 0.f; // , expr subst + i__2 = *n - k; + caxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], &c__1); + i__2 = *n - k; + q__1.r = -1.f; + q__1.i = -0.f; // , expr subst + cher2_(uplo, &i__2, &q__1, &a[k + 1 + k * a_dim1], &c__1, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + (k + 1) * a_dim1], lda); + i__2 = *n - k; + caxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], &c__1); + i__2 = *n - k; + ctrsv_(uplo, "No transpose", "Non-unit", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb, &a[k + 1 + k * a_dim1], &c__1); + } + /* L20: */ + } + } + } + else + { + if (upper) + { + /* Compute U*A*U**H */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the upper triangle of A(1:k,1:k) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + i__2 = k - 1; + ctrmv_(uplo, "No transpose", "Non-unit", &i__2, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1); + r__1 = akk * .5f; + ct.r = r__1; + ct.i = 0.f; // , expr subst + i__2 = k - 1; + caxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1); + i__2 = k - 1; + cher2_(uplo, &i__2, &c_b1, &a[k * a_dim1 + 1], &c__1, &b[k * b_dim1 + 1], &c__1, &a[a_offset], lda); + i__2 = k - 1; + caxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1); + i__2 = k - 1; + csscal_(&i__2, &bkk, &a[k * a_dim1 + 1], &c__1); + i__2 = k + k * a_dim1; + /* Computing 2nd power */ + r__2 = bkk; + r__1 = akk * (r__2 * r__2); + a[i__2].r = r__1; + a[i__2].i = 0.f; // , expr subst + /* L30: */ + } + } + else + { + /* Compute L**H *A*L */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the lower triangle of A(1:k,1:k) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + i__2 = k - 1; + clacgv_(&i__2, &a[k + a_dim1], lda); + i__2 = k - 1; + ctrmv_(uplo, "Conjugate transpose", "Non-unit", &i__2, &b[ b_offset], ldb, &a[k + a_dim1], lda); + r__1 = akk * .5f; + ct.r = r__1; + ct.i = 0.f; // , expr subst + i__2 = k - 1; + clacgv_(&i__2, &b[k + b_dim1], ldb); + i__2 = k - 1; + caxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda); + i__2 = k - 1; + cher2_(uplo, &i__2, &c_b1, &a[k + a_dim1], lda, &b[k + b_dim1], ldb, &a[a_offset], lda); + i__2 = k - 1; + caxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda); + i__2 = k - 1; + clacgv_(&i__2, &b[k + b_dim1], ldb); + i__2 = k - 1; + csscal_(&i__2, &bkk, &a[k + a_dim1], lda); + i__2 = k - 1; + clacgv_(&i__2, &a[k + a_dim1], lda); + i__2 = k + k * a_dim1; + /* Computing 2nd power */ + r__2 = bkk; + r__1 = akk * (r__2 * r__2); + a[i__2].r = r__1; + a[i__2].i = 0.f; // , expr subst + /* L40: */ + } + } + } + return 0; + /* End of CHEGS2 */ +} +/* chegs2_ */ diff --git a/src/map/lapack2flamec/f2c/flamec/hegs/chegst_fla.c b/src/map/lapack2flamec/f2c/flamec/hegs/chegst_fla.c new file mode 100644 index 000000000..795fb670c --- /dev/null +++ b/src/map/lapack2flamec/f2c/flamec/hegs/chegst_fla.c @@ -0,0 +1,355 @@ +/* chegst.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ +#include "FLA_f2c.h" /* Table of constant values */ +static complex c_b1 = +{ + 1.f,0.f +} +; +static complex c_b2 = +{ + .5f,0.f +} +; +static integer c__1 = 1; +static integer c_n1 = -1; +static real c_b18 = 1.f; +/* > \brief \b CHEGST */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* > \htmlonly */ +/* > Download CHEGST + dependencies */ +/* > */ +/* > [TGZ] */ +/* > */ +/* > [ZIP] */ +/* > */ +/* > [TXT] */ +/* > \endhtmlonly */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) */ +/* .. Scalar Arguments .. */ +/* CHARACTER UPLO */ +/* INTEGER INFO, ITYPE, LDA, LDB, N */ +/* .. */ +/* .. Array Arguments .. */ +/* COMPLEX A( LDA, * ), B( LDB, * ) */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > CHEGST reduces a complex Hermitian-definite generalized */ +/* > eigenproblem to standard form. */ +/* > */ +/* > If ITYPE = 1, the problem is A*x = lambda*B*x, */ +/* > and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H) */ +/* > */ +/* > If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or */ +/* > B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H*A*L. */ +/* > */ +/* > B must have been previously factorized as U**H*U or L*L**H by CPOTRF. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] ITYPE */ +/* > \verbatim */ +/* > ITYPE is INTEGER */ +/* > = 1: compute inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H); +*/ +/* > = 2 or 3: compute U*A*U**H or L**H*A*L. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] UPLO */ +/* > \verbatim */ +/* > UPLO is CHARACTER*1 */ +/* > = 'U': Upper triangle of A is stored and B is factored as */ +/* > U**H*U; +*/ +/* > = 'L': Lower triangle of A is stored and B is factored as */ +/* > L*L**H. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] N */ +/* > \verbatim */ +/* > N is INTEGER */ +/* > The order of the matrices A and B. N >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] A */ +/* > \verbatim */ +/* > A is COMPLEX array, dimension (LDA,N) */ +/* > On entry, the Hermitian matrix A. If UPLO = 'U', the leading */ +/* > N-by-N upper triangular part of A contains the upper */ +/* > triangular part of the matrix A, and the strictly lower */ +/* > triangular part of A is not referenced. If UPLO = 'L', the */ +/* > leading N-by-N lower triangular part of A contains the lower */ +/* > triangular part of the matrix A, and the strictly upper */ +/* > triangular part of A is not referenced. */ +/* > */ +/* > On exit, if INFO = 0, the transformed matrix, stored in the */ +/* > same format as A. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDA */ +/* > \verbatim */ +/* > LDA is INTEGER */ +/* > The leading dimension of the array A. LDA >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] B */ +/* > \verbatim */ +/* > B is COMPLEX array, dimension (LDB,N) */ +/* > The triangular factor from the Cholesky factorization of B, */ +/* > as returned by CPOTRF. */ +/* > B is modified by the routine but restored on exit. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDB */ +/* > \verbatim */ +/* > LDB is INTEGER */ +/* > The leading dimension of the array B. LDB >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] INFO */ +/* > \verbatim */ +/* > INFO is INTEGER */ +/* > = 0: successful exit */ +/* > < 0: if INFO = -i, the i-th argument had an illegal value */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Univ. of Tennessee */ +/* > \author Univ. of California Berkeley */ +/* > \author Univ. of Colorado Denver */ +/* > \author NAG Ltd. */ +/* > \ingroup complexHEcomputational */ +/* ===================================================================== */ +/* Subroutine */ +int chegst_fla(integer *itype, char *uplo, integer *n, complex * a, integer *lda, complex *b, integer *ldb, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3; + complex q__1; + /* Local variables */ + integer k, kb, nb; + extern /* Subroutine */ + int chemm_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, complex *, complex *, integer *); + extern logical lsame_(char *, char *); + extern /* Subroutine */ + int ctrmm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *); + logical upper; + extern /* Subroutine */ + int chegs2_(integer *, char *, integer *, complex *, integer *, complex *, integer *, integer *), cher2k_( char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); + extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); + /* -- LAPACK computational routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* .. Scalar Arguments .. */ + /* .. */ + /* .. Array Arguments .. */ + /* .. */ + /* ===================================================================== */ + /* .. Parameters .. */ + /* .. */ + /* .. Local Scalars .. */ + /* .. */ + /* .. External Subroutines .. */ + /* .. */ + /* .. Intrinsic Functions .. */ + /* .. */ + /* .. External Functions .. */ + /* .. */ + /* .. Executable Statements .. */ + /* Test the input parameters. */ + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1; + b -= b_offset; + /* Function Body */ + *info = 0; + upper = lsame_(uplo, "U"); + if (*itype < 1 || *itype > 3) + { + *info = -1; + } + else if (! upper && ! lsame_(uplo, "L")) + { + *info = -2; + } + else if (*n < 0) + { + *info = -3; + } + else if (*lda < fla_max(1,*n)) + { + *info = -5; + } + else if (*ldb < fla_max(1,*n)) + { + *info = -7; + } + if (*info != 0) + { + i__1 = -(*info); + xerbla_("CHEGST", &i__1, (ftnlen)6); + return 0; + } + /* Quick return if possible */ + if (*n == 0) + { + return 0; + } + /* Determine the block size for this environment. */ + nb = ilaenv_(&c__1, "CHEGST", uplo, n, &c_n1, &c_n1, &c_n1); + if (nb <= 1 || nb >= *n) + { + /* Use unblocked code */ + chegs2_(itype, uplo, n, &a[a_offset], lda, &b[b_offset], ldb, info); + } + else + { + /* Use blocked code */ + if (*itype == 1) + { + if (upper) + { + /* Compute inv(U**H)*A*inv(U) */ + i__1 = *n; + i__2 = nb; + for (k = 1; + i__2 < 0 ? k >= i__1 : k <= i__1; + k += i__2) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the upper triangle of A(k:n,k:n) */ + chegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + if (k + kb <= *n) + { + i__3 = *n - k - kb + 1; + ctrsm_("Left", uplo, "Conjugate transpose", "Non-unit", &kb, &i__3, &c_b1, &b[k + k * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + q__1.r = -.5f; + q__1.i = -0.f; // , expr subst + chemm_("Left", uplo, &kb, &i__3, &q__1, &a[k + k * a_dim1], lda, &b[k + (k + kb) * b_dim1], ldb, &c_b1, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + q__1.r = -1.f; + q__1.i = -0.f; // , expr subst + cher2k_(uplo, "Conjugate transpose", &i__3, &kb, & q__1, &a[k + (k + kb) * a_dim1], lda, &b[k + ( k + kb) * b_dim1], ldb, &c_b18, &a[k + kb + ( k + kb) * a_dim1], lda) ; + i__3 = *n - k - kb + 1; + q__1.r = -.5f; + q__1.i = -0.f; // , expr subst + chemm_("Left", uplo, &kb, &i__3, &q__1, &a[k + k * a_dim1], lda, &b[k + (k + kb) * b_dim1], ldb, &c_b1, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + ctrsm_("Right", uplo, "No transpose", "Non-unit", &kb, &i__3, &c_b1, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda); + } + /* L10: */ + } + } + else + { + /* Compute inv(L)*A*inv(L**H) */ + i__2 = *n; + i__1 = nb; + for (k = 1; + i__1 < 0 ? k >= i__2 : k <= i__2; + k += i__1) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the lower triangle of A(k:n,k:n) */ + chegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + if (k + kb <= *n) + { + i__3 = *n - k - kb + 1; + ctrsm_("Right", uplo, "Conjugate transpose", "Non-un" "it", &i__3, &kb, &c_b1, &b[k + k * b_dim1], ldb, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + q__1.r = -.5f; + q__1.i = -0.f; // , expr subst + chemm_("Right", uplo, &i__3, &kb, &q__1, &a[k + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, & c_b1, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + q__1.r = -1.f; + q__1.i = -0.f; // , expr subst + cher2k_(uplo, "No transpose", &i__3, &kb, &q__1, &a[k + kb + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, &c_b18, &a[k + kb + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + q__1.r = -.5f; + q__1.i = -0.f; // , expr subst + chemm_("Right", uplo, &i__3, &kb, &q__1, &a[k + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, & c_b1, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + ctrsm_("Left", uplo, "No transpose", "Non-unit", & i__3, &kb, &c_b1, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + kb + k * a_dim1], lda); + } + /* L20: */ + } + } + } + else + { + if (upper) + { + /* Compute U*A*U**H */ + i__1 = *n; + i__2 = nb; + for (k = 1; + i__2 < 0 ? k >= i__1 : k <= i__1; + k += i__2) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the upper triangle of A(1:k+kb-1,1:k+kb-1) */ + i__3 = k - 1; + ctrmm_("Left", uplo, "No transpose", "Non-unit", &i__3, & kb, &c_b1, &b[b_offset], ldb, &a[k * a_dim1 + 1], lda); + i__3 = k - 1; + chemm_("Right", uplo, &i__3, &kb, &c_b2, &a[k + k * a_dim1], lda, &b[k * b_dim1 + 1], ldb, &c_b1, &a[ k * a_dim1 + 1], lda); + i__3 = k - 1; + cher2k_(uplo, "No transpose", &i__3, &kb, &c_b1, &a[k * a_dim1 + 1], lda, &b[k * b_dim1 + 1], ldb, &c_b18, &a[a_offset], lda); + i__3 = k - 1; + chemm_("Right", uplo, &i__3, &kb, &c_b2, &a[k + k * a_dim1], lda, &b[k * b_dim1 + 1], ldb, &c_b1, &a[ k * a_dim1 + 1], lda); + i__3 = k - 1; + ctrmm_("Right", uplo, "Conjugate transpose", "Non-unit", & i__3, &kb, &c_b1, &b[k + k * b_dim1], ldb, &a[k * a_dim1 + 1], lda); + chegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + /* L30: */ + } + } + else + { + /* Compute L**H*A*L */ + i__2 = *n; + i__1 = nb; + for (k = 1; + i__1 < 0 ? k >= i__2 : k <= i__2; + k += i__1) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the lower triangle of A(1:k+kb-1,1:k+kb-1) */ + i__3 = k - 1; + ctrmm_("Right", uplo, "No transpose", "Non-unit", &kb, & i__3, &c_b1, &b[b_offset], ldb, &a[k + a_dim1], lda); + i__3 = k - 1; + chemm_("Left", uplo, &kb, &i__3, &c_b2, &a[k + k * a_dim1], lda, &b[k + b_dim1], ldb, &c_b1, &a[k + a_dim1], lda); + i__3 = k - 1; + cher2k_(uplo, "Conjugate transpose", &i__3, &kb, &c_b1, & a[k + a_dim1], lda, &b[k + b_dim1], ldb, &c_b18, & a[a_offset], lda); + i__3 = k - 1; + chemm_("Left", uplo, &kb, &i__3, &c_b2, &a[k + k * a_dim1], lda, &b[k + b_dim1], ldb, &c_b1, &a[k + a_dim1], lda); + i__3 = k - 1; + ctrmm_("Left", uplo, "Conjugate transpose", "Non-unit", & kb, &i__3, &c_b1, &b[k + k * b_dim1], ldb, &a[k + a_dim1], lda); + chegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + /* L40: */ + } + } + } + } + return 0; + /* End of CHEGST */ +} +/* chegst_ */ diff --git a/src/map/lapack2flamec/f2c/flamec/hegs/zhegs2_fla.c b/src/map/lapack2flamec/f2c/flamec/hegs/zhegs2_fla.c new file mode 100644 index 000000000..957cce6ed --- /dev/null +++ b/src/map/lapack2flamec/f2c/flamec/hegs/zhegs2_fla.c @@ -0,0 +1,373 @@ +/* zhegs2.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ +#include "FLA_f2c.h" /* Table of constant values */ +static doublecomplex c_b1 = +{ + 1.,0. +} +; +static integer c__1 = 1; +/* > \brief \b ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factor ization results obtained from cpotrf (unblocked algorithm). */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* > \htmlonly */ +/* > Download ZHEGS2 + dependencies */ +/* > */ +/* > [TGZ] */ +/* > */ +/* > [ZIP] */ +/* > */ +/* > [TXT] */ +/* > \endhtmlonly */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) */ +/* .. Scalar Arguments .. */ +/* CHARACTER UPLO */ +/* INTEGER INFO, ITYPE, LDA, LDB, N */ +/* .. */ +/* .. Array Arguments .. */ +/* COMPLEX*16 A( LDA, * ), B( LDB, * ) */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > ZHEGS2 reduces a complex Hermitian-definite generalized */ +/* > eigenproblem to standard form. */ +/* > */ +/* > If ITYPE = 1, the problem is A*x = lambda*B*x, */ +/* > and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H) */ +/* > */ +/* > If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or */ +/* > B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H *A*L. */ +/* > */ +/* > B must have been previously factorized as U**H *U or L*L**H by ZPOTRF. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] ITYPE */ +/* > \verbatim */ +/* > ITYPE is INTEGER */ +/* > = 1: compute inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H); +*/ +/* > = 2 or 3: compute U*A*U**H or L**H *A*L. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] UPLO */ +/* > \verbatim */ +/* > UPLO is CHARACTER*1 */ +/* > Specifies whether the upper or lower triangular part of the */ +/* > Hermitian matrix A is stored, and how B has been factorized. */ +/* > = 'U': Upper triangular */ +/* > = 'L': Lower triangular */ +/* > \endverbatim */ +/* > */ +/* > \param[in] N */ +/* > \verbatim */ +/* > N is INTEGER */ +/* > The order of the matrices A and B. N >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] A */ +/* > \verbatim */ +/* > A is COMPLEX*16 array, dimension (LDA,N) */ +/* > On entry, the Hermitian matrix A. If UPLO = 'U', the leading */ +/* > n by n upper triangular part of A contains the upper */ +/* > triangular part of the matrix A, and the strictly lower */ +/* > triangular part of A is not referenced. If UPLO = 'L', the */ +/* > leading n by n lower triangular part of A contains the lower */ +/* > triangular part of the matrix A, and the strictly upper */ +/* > triangular part of A is not referenced. */ +/* > */ +/* > On exit, if INFO = 0, the transformed matrix, stored in the */ +/* > same format as A. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDA */ +/* > \verbatim */ +/* > LDA is INTEGER */ +/* > The leading dimension of the array A. LDA >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] B */ +/* > \verbatim */ +/* > B is COMPLEX*16 array, dimension (LDB,N) */ +/* > The triangular factor from the Cholesky factorization of B, */ +/* > as returned by ZPOTRF. */ +/* > B is modified by the routine but restored on exit. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDB */ +/* > \verbatim */ +/* > LDB is INTEGER */ +/* > The leading dimension of the array B. LDB >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] INFO */ +/* > \verbatim */ +/* > INFO is INTEGER */ +/* > = 0: successful exit. */ +/* > < 0: if INFO = -i, the i-th argument had an illegal value. */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Univ. of Tennessee */ +/* > \author Univ. of California Berkeley */ +/* > \author Univ. of Colorado Denver */ +/* > \author NAG Ltd. */ +/* > \ingroup complex16HEcomputational */ +/* ===================================================================== */ +/* Subroutine */ +int zhegs2_fla(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2; + doublereal d__1, d__2; + doublecomplex z__1; + /* Local variables */ + integer k; + doublecomplex ct; + doublereal akk, bkk; + extern /* Subroutine */ + int zher2_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *); + extern logical lsame_(char *, char *); + logical upper; + extern /* Subroutine */ + int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrmv_( char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsv_(char *, char *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zdscal_(integer *, doublereal *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *, integer *); + /* -- LAPACK computational routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* .. Scalar Arguments .. */ + /* .. */ + /* .. Array Arguments .. */ + /* .. */ + /* ===================================================================== */ + /* .. Parameters .. */ + /* .. */ + /* .. Local Scalars .. */ + /* .. */ + /* .. External Subroutines .. */ + /* .. */ + /* .. Intrinsic Functions .. */ + /* .. */ + /* .. External Functions .. */ + /* .. */ + /* .. Executable Statements .. */ + /* Test the input parameters. */ + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1; + b -= b_offset; + /* Function Body */ + *info = 0; + upper = lsame_(uplo, "U"); + if (*itype < 1 || *itype > 3) + { + *info = -1; + } + else if (! upper && ! lsame_(uplo, "L")) + { + *info = -2; + } + else if (*n < 0) + { + *info = -3; + } + else if (*lda < fla_max(1,*n)) + { + *info = -5; + } + else if (*ldb < fla_max(1,*n)) + { + *info = -7; + } + if (*info != 0) + { + i__1 = -(*info); + xerbla_("ZHEGS2", &i__1, (ftnlen)6); + return 0; + } + if (*itype == 1) + { + if (upper) + { + /* Compute inv(U**H)*A*inv(U) */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the upper triangle of A(k:n,k:n) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + /* Computing 2nd power */ + d__1 = bkk; + akk /= d__1 * d__1; + i__2 = k + k * a_dim1; + a[i__2].r = akk; + a[i__2].i = 0.; // , expr subst + if (k < *n) + { + i__2 = *n - k; + d__1 = 1. / bkk; + zdscal_(&i__2, &d__1, &a[k + (k + 1) * a_dim1], lda); + d__1 = akk * -.5; + ct.r = d__1; + ct.i = 0.; // , expr subst + i__2 = *n - k; + zlacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda); + i__2 = *n - k; + zlacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb); + i__2 = *n - k; + zaxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + ( k + 1) * a_dim1], lda); + i__2 = *n - k; + z__1.r = -1.; + z__1.i = -0.; // , expr subst + zher2_(uplo, &i__2, &z__1, &a[k + (k + 1) * a_dim1], lda, &b[k + (k + 1) * b_dim1], ldb, &a[k + 1 + (k + 1) * a_dim1], lda); + i__2 = *n - k; + zaxpy_(&i__2, &ct, &b[k + (k + 1) * b_dim1], ldb, &a[k + ( k + 1) * a_dim1], lda); + i__2 = *n - k; + zlacgv_(&i__2, &b[k + (k + 1) * b_dim1], ldb); + i__2 = *n - k; + ztrsv_(uplo, "Conjugate transpose", "Non-unit", &i__2, &b[ k + 1 + (k + 1) * b_dim1], ldb, &a[k + (k + 1) * a_dim1], lda); + i__2 = *n - k; + zlacgv_(&i__2, &a[k + (k + 1) * a_dim1], lda); + } + /* L10: */ + } + } + else + { + /* Compute inv(L)*A*inv(L**H) */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the lower triangle of A(k:n,k:n) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + /* Computing 2nd power */ + d__1 = bkk; + akk /= d__1 * d__1; + i__2 = k + k * a_dim1; + a[i__2].r = akk; + a[i__2].i = 0.; // , expr subst + if (k < *n) + { + i__2 = *n - k; + d__1 = 1. / bkk; + zdscal_(&i__2, &d__1, &a[k + 1 + k * a_dim1], &c__1); + d__1 = akk * -.5; + ct.r = d__1; + ct.i = 0.; // , expr subst + i__2 = *n - k; + zaxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], &c__1); + i__2 = *n - k; + z__1.r = -1.; + z__1.i = -0.; // , expr subst + zher2_(uplo, &i__2, &z__1, &a[k + 1 + k * a_dim1], &c__1, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + (k + 1) * a_dim1], lda); + i__2 = *n - k; + zaxpy_(&i__2, &ct, &b[k + 1 + k * b_dim1], &c__1, &a[k + 1 + k * a_dim1], &c__1); + i__2 = *n - k; + ztrsv_(uplo, "No transpose", "Non-unit", &i__2, &b[k + 1 + (k + 1) * b_dim1], ldb, &a[k + 1 + k * a_dim1], &c__1); + } + /* L20: */ + } + } + } + else + { + if (upper) + { + /* Compute U*A*U**H */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the upper triangle of A(1:k,1:k) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + i__2 = k - 1; + ztrmv_(uplo, "No transpose", "Non-unit", &i__2, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1); + d__1 = akk * .5; + ct.r = d__1; + ct.i = 0.; // , expr subst + i__2 = k - 1; + zaxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1); + i__2 = k - 1; + zher2_(uplo, &i__2, &c_b1, &a[k * a_dim1 + 1], &c__1, &b[k * b_dim1 + 1], &c__1, &a[a_offset], lda); + i__2 = k - 1; + zaxpy_(&i__2, &ct, &b[k * b_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1); + i__2 = k - 1; + zdscal_(&i__2, &bkk, &a[k * a_dim1 + 1], &c__1); + i__2 = k + k * a_dim1; + /* Computing 2nd power */ + d__2 = bkk; + d__1 = akk * (d__2 * d__2); + a[i__2].r = d__1; + a[i__2].i = 0.; // , expr subst + /* L30: */ + } + } + else + { + /* Compute L**H *A*L */ + i__1 = *n; + for (k = 1; + k <= i__1; + ++k) + { + /* Update the lower triangle of A(1:k,1:k) */ + i__2 = k + k * a_dim1; + akk = a[i__2].r; + i__2 = k + k * b_dim1; + bkk = b[i__2].r; + i__2 = k - 1; + zlacgv_(&i__2, &a[k + a_dim1], lda); + i__2 = k - 1; + ztrmv_(uplo, "Conjugate transpose", "Non-unit", &i__2, &b[ b_offset], ldb, &a[k + a_dim1], lda); + d__1 = akk * .5; + ct.r = d__1; + ct.i = 0.; // , expr subst + i__2 = k - 1; + zlacgv_(&i__2, &b[k + b_dim1], ldb); + i__2 = k - 1; + zaxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda); + i__2 = k - 1; + zher2_(uplo, &i__2, &c_b1, &a[k + a_dim1], lda, &b[k + b_dim1], ldb, &a[a_offset], lda); + i__2 = k - 1; + zaxpy_(&i__2, &ct, &b[k + b_dim1], ldb, &a[k + a_dim1], lda); + i__2 = k - 1; + zlacgv_(&i__2, &b[k + b_dim1], ldb); + i__2 = k - 1; + zdscal_(&i__2, &bkk, &a[k + a_dim1], lda); + i__2 = k - 1; + zlacgv_(&i__2, &a[k + a_dim1], lda); + i__2 = k + k * a_dim1; + /* Computing 2nd power */ + d__2 = bkk; + d__1 = akk * (d__2 * d__2); + a[i__2].r = d__1; + a[i__2].i = 0.; // , expr subst + /* L40: */ + } + } + } + return 0; + /* End of ZHEGS2 */ +} +/* zhegs2_ */ diff --git a/src/map/lapack2flamec/f2c/flamec/hegs/zhegst_fla.c b/src/map/lapack2flamec/f2c/flamec/hegs/zhegst_fla.c new file mode 100644 index 000000000..c37c30d0a --- /dev/null +++ b/src/map/lapack2flamec/f2c/flamec/hegs/zhegst_fla.c @@ -0,0 +1,353 @@ +/* zhegst.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ +#include "FLA_f2c.h" /* Table of constant values */ +static doublecomplex c_b1 = +{ + 1.,0. +} +; +static doublecomplex c_b2 = +{ + .5,0. +} +; +static integer c__1 = 1; +static integer c_n1 = -1; +static doublereal c_b18 = 1.; +/* > \brief \b ZHEGST */ +/* =========== DOCUMENTATION =========== */ +/* Online html documentation available at */ +/* http://www.netlib.org/lapack/explore-html/ */ +/* > \htmlonly */ +/* > Download ZHEGST + dependencies */ +/* > */ +/* > [TGZ] */ +/* > */ +/* > [ZIP] */ +/* > */ +/* > [TXT] */ +/* > \endhtmlonly */ +/* Definition: */ +/* =========== */ +/* SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) */ +/* .. Scalar Arguments .. */ +/* CHARACTER UPLO */ +/* INTEGER INFO, ITYPE, LDA, LDB, N */ +/* .. */ +/* .. Array Arguments .. */ +/* COMPLEX*16 A( LDA, * ), B( LDB, * ) */ +/* .. */ +/* > \par Purpose: */ +/* ============= */ +/* > */ +/* > \verbatim */ +/* > */ +/* > ZHEGST reduces a complex Hermitian-definite generalized */ +/* > eigenproblem to standard form. */ +/* > */ +/* > If ITYPE = 1, the problem is A*x = lambda*B*x, */ +/* > and A is overwritten by inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H) */ +/* > */ +/* > If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or */ +/* > B*A*x = lambda*x, and A is overwritten by U*A*U**H or L**H*A*L. */ +/* > */ +/* > B must have been previously factorized as U**H*U or L*L**H by ZPOTRF. */ +/* > \endverbatim */ +/* Arguments: */ +/* ========== */ +/* > \param[in] ITYPE */ +/* > \verbatim */ +/* > ITYPE is INTEGER */ +/* > = 1: compute inv(U**H)*A*inv(U) or inv(L)*A*inv(L**H); +*/ +/* > = 2 or 3: compute U*A*U**H or L**H*A*L. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] UPLO */ +/* > \verbatim */ +/* > UPLO is CHARACTER*1 */ +/* > = 'U': Upper triangle of A is stored and B is factored as */ +/* > U**H*U; +*/ +/* > = 'L': Lower triangle of A is stored and B is factored as */ +/* > L*L**H. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] N */ +/* > \verbatim */ +/* > N is INTEGER */ +/* > The order of the matrices A and B. N >= 0. */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] A */ +/* > \verbatim */ +/* > A is COMPLEX*16 array, dimension (LDA,N) */ +/* > On entry, the Hermitian matrix A. If UPLO = 'U', the leading */ +/* > N-by-N upper triangular part of A contains the upper */ +/* > triangular part of the matrix A, and the strictly lower */ +/* > triangular part of A is not referenced. If UPLO = 'L', the */ +/* > leading N-by-N lower triangular part of A contains the lower */ +/* > triangular part of the matrix A, and the strictly upper */ +/* > triangular part of A is not referenced. */ +/* > */ +/* > On exit, if INFO = 0, the transformed matrix, stored in the */ +/* > same format as A. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDA */ +/* > \verbatim */ +/* > LDA is INTEGER */ +/* > The leading dimension of the array A. LDA >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[in,out] B */ +/* > \verbatim */ +/* > B is COMPLEX*16 array, dimension (LDB,N) */ +/* > The triangular factor from the Cholesky factorization of B, */ +/* > as returned by ZPOTRF. */ +/* > B is modified by the routine but restored on exit. */ +/* > \endverbatim */ +/* > */ +/* > \param[in] LDB */ +/* > \verbatim */ +/* > LDB is INTEGER */ +/* > The leading dimension of the array B. LDB >= fla_max(1,N). */ +/* > \endverbatim */ +/* > */ +/* > \param[out] INFO */ +/* > \verbatim */ +/* > INFO is INTEGER */ +/* > = 0: successful exit */ +/* > < 0: if INFO = -i, the i-th argument had an illegal value */ +/* > \endverbatim */ +/* Authors: */ +/* ======== */ +/* > \author Univ. of Tennessee */ +/* > \author Univ. of California Berkeley */ +/* > \author Univ. of Colorado Denver */ +/* > \author NAG Ltd. */ +/* > \ingroup complex16HEcomputational */ +/* ===================================================================== */ +/* Subroutine */ +int zhegst_fla(integer *itype, char *uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3; + doublecomplex z__1; + /* Local variables */ + integer k, kb, nb; + extern logical lsame_(char *, char *); + extern /* Subroutine */ + int zhemm_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); + logical upper; + extern /* Subroutine */ + int ztrmm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), ztrsm_(char *, char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), zhegs2_(integer *, char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); + extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); + /* -- LAPACK computational routine -- */ + /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ + /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ + /* .. Scalar Arguments .. */ + /* .. */ + /* .. Array Arguments .. */ + /* .. */ + /* ===================================================================== */ + /* .. Parameters .. */ + /* .. */ + /* .. Local Scalars .. */ + /* .. */ + /* .. External Subroutines .. */ + /* .. */ + /* .. Intrinsic Functions .. */ + /* .. */ + /* .. External Functions .. */ + /* .. */ + /* .. Executable Statements .. */ + /* Test the input parameters. */ + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1; + b -= b_offset; + /* Function Body */ + *info = 0; + upper = lsame_(uplo, "U"); + if (*itype < 1 || *itype > 3) + { + *info = -1; + } + else if (! upper && ! lsame_(uplo, "L")) + { + *info = -2; + } + else if (*n < 0) + { + *info = -3; + } + else if (*lda < fla_max(1,*n)) + { + *info = -5; + } + else if (*ldb < fla_max(1,*n)) + { + *info = -7; + } + if (*info != 0) + { + i__1 = -(*info); + xerbla_("ZHEGST", &i__1, (ftnlen)6); + return 0; + } + /* Quick return if possible */ + if (*n == 0) + { + return 0; + } + /* Determine the block size for this environment. */ + nb = ilaenv_(&c__1, "ZHEGST", uplo, n, &c_n1, &c_n1, &c_n1); + if (nb <= 1 || nb >= *n) + { + /* Use unblocked code */ + zhegs2_(itype, uplo, n, &a[a_offset], lda, &b[b_offset], ldb, info); + } + else + { + /* Use blocked code */ + if (*itype == 1) + { + if (upper) + { + /* Compute inv(U**H)*A*inv(U) */ + i__1 = *n; + i__2 = nb; + for (k = 1; + i__2 < 0 ? k >= i__1 : k <= i__1; + k += i__2) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the upper triangle of A(k:n,k:n) */ + zhegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + if (k + kb <= *n) + { + i__3 = *n - k - kb + 1; + ztrsm_("Left", uplo, "Conjugate transpose", "Non-unit", &kb, &i__3, &c_b1, &b[k + k * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + z__1.r = -.5; + z__1.i = -0.; // , expr subst + zhemm_("Left", uplo, &kb, &i__3, &z__1, &a[k + k * a_dim1], lda, &b[k + (k + kb) * b_dim1], ldb, &c_b1, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + z__1.r = -1.; + z__1.i = -0.; // , expr subst + zher2k_(uplo, "Conjugate transpose", &i__3, &kb, & z__1, &a[k + (k + kb) * a_dim1], lda, &b[k + ( k + kb) * b_dim1], ldb, &c_b18, &a[k + kb + ( k + kb) * a_dim1], lda) ; + i__3 = *n - k - kb + 1; + z__1.r = -.5; + z__1.i = -0.; // , expr subst + zhemm_("Left", uplo, &kb, &i__3, &z__1, &a[k + k * a_dim1], lda, &b[k + (k + kb) * b_dim1], ldb, &c_b1, &a[k + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + ztrsm_("Right", uplo, "No transpose", "Non-unit", &kb, &i__3, &c_b1, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + (k + kb) * a_dim1], lda); + } + /* L10: */ + } + } + else + { + /* Compute inv(L)*A*inv(L**H) */ + i__2 = *n; + i__1 = nb; + for (k = 1; + i__1 < 0 ? k >= i__2 : k <= i__2; + k += i__1) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the lower triangle of A(k:n,k:n) */ + zhegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + if (k + kb <= *n) + { + i__3 = *n - k - kb + 1; + ztrsm_("Right", uplo, "Conjugate transpose", "Non-un" "it", &i__3, &kb, &c_b1, &b[k + k * b_dim1], ldb, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + z__1.r = -.5; + z__1.i = -0.; // , expr subst + zhemm_("Right", uplo, &i__3, &kb, &z__1, &a[k + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, & c_b1, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + z__1.r = -1.; + z__1.i = -0.; // , expr subst + zher2k_(uplo, "No transpose", &i__3, &kb, &z__1, &a[k + kb + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, &c_b18, &a[k + kb + (k + kb) * a_dim1], lda); + i__3 = *n - k - kb + 1; + z__1.r = -.5; + z__1.i = -0.; // , expr subst + zhemm_("Right", uplo, &i__3, &kb, &z__1, &a[k + k * a_dim1], lda, &b[k + kb + k * b_dim1], ldb, & c_b1, &a[k + kb + k * a_dim1], lda); + i__3 = *n - k - kb + 1; + ztrsm_("Left", uplo, "No transpose", "Non-unit", & i__3, &kb, &c_b1, &b[k + kb + (k + kb) * b_dim1], ldb, &a[k + kb + k * a_dim1], lda); + } + /* L20: */ + } + } + } + else + { + if (upper) + { + /* Compute U*A*U**H */ + i__1 = *n; + i__2 = nb; + for (k = 1; + i__2 < 0 ? k >= i__1 : k <= i__1; + k += i__2) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the upper triangle of A(1:k+kb-1,1:k+kb-1) */ + i__3 = k - 1; + ztrmm_("Left", uplo, "No transpose", "Non-unit", &i__3, & kb, &c_b1, &b[b_offset], ldb, &a[k * a_dim1 + 1], lda); + i__3 = k - 1; + zhemm_("Right", uplo, &i__3, &kb, &c_b2, &a[k + k * a_dim1], lda, &b[k * b_dim1 + 1], ldb, &c_b1, &a[ k * a_dim1 + 1], lda); + i__3 = k - 1; + zher2k_(uplo, "No transpose", &i__3, &kb, &c_b1, &a[k * a_dim1 + 1], lda, &b[k * b_dim1 + 1], ldb, &c_b18, &a[a_offset], lda); + i__3 = k - 1; + zhemm_("Right", uplo, &i__3, &kb, &c_b2, &a[k + k * a_dim1], lda, &b[k * b_dim1 + 1], ldb, &c_b1, &a[ k * a_dim1 + 1], lda); + i__3 = k - 1; + ztrmm_("Right", uplo, "Conjugate transpose", "Non-unit", & i__3, &kb, &c_b1, &b[k + k * b_dim1], ldb, &a[k * a_dim1 + 1], lda); + zhegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + /* L30: */ + } + } + else + { + /* Compute L**H*A*L */ + i__2 = *n; + i__1 = nb; + for (k = 1; + i__1 < 0 ? k >= i__2 : k <= i__2; + k += i__1) + { + /* Computing MIN */ + i__3 = *n - k + 1; + kb = fla_min(i__3,nb); + /* Update the lower triangle of A(1:k+kb-1,1:k+kb-1) */ + i__3 = k - 1; + ztrmm_("Right", uplo, "No transpose", "Non-unit", &kb, & i__3, &c_b1, &b[b_offset], ldb, &a[k + a_dim1], lda); + i__3 = k - 1; + zhemm_("Left", uplo, &kb, &i__3, &c_b2, &a[k + k * a_dim1], lda, &b[k + b_dim1], ldb, &c_b1, &a[k + a_dim1], lda); + i__3 = k - 1; + zher2k_(uplo, "Conjugate transpose", &i__3, &kb, &c_b1, & a[k + a_dim1], lda, &b[k + b_dim1], ldb, &c_b18, & a[a_offset], lda); + i__3 = k - 1; + zhemm_("Left", uplo, &kb, &i__3, &c_b2, &a[k + k * a_dim1], lda, &b[k + b_dim1], ldb, &c_b1, &a[k + a_dim1], lda); + i__3 = k - 1; + ztrmm_("Left", uplo, "Conjugate transpose", "Non-unit", & kb, &i__3, &c_b1, &b[k + k * b_dim1], ldb, &a[k + a_dim1], lda); + zhegs2_(itype, uplo, &kb, &a[k + k * a_dim1], lda, &b[k + k * b_dim1], ldb, info); + /* L40: */ + } + } + } + } + return 0; + /* End of ZHEGST */ +} +/* zhegst_ */ diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/chetd2_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/chetd2_fla.c index 133da473b..3294f387f 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/chetd2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/chetd2_fla.c @@ -190,7 +190,7 @@ int chetd2_fla(char *uplo, integer *n, complex *a, integer *lda, real *d__, real int chemv_(char *, integer *, complex *, complex * , integer *, complex *, integer *, complex *, complex *, integer * ), caxpy_(integer *, complex *, complex *, integer *, complex *, integer *); logical upper; extern /* Subroutine */ - int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); + int clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -237,7 +237,7 @@ int chetd2_fla(char *uplo, integer *n, complex *a, integer *lda, real *d__, real if (*info != 0) { i__1 = -(*info); - xerbla_("CHETD2", &i__1); + xerbla_("CHETD2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/chetrd_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/chetrd_fla.c index c27f846d8..38c961d1a 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/chetrd_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/chetrd_fla.c @@ -200,7 +200,7 @@ int chetrd_fla(char *uplo, integer *n, complex *a, integer *lda, real *d__, real integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int chetd2_fla(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer *, real *, complex *, complex *, integer *), xerbla_(char *, integer *); + int chetd2_fla(char *, integer *, complex *, integer *, real *, real *, complex *, integer *), cher2k_(char *, char *, integer *, integer *, complex *, complex *, integer *, complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer *, real *, complex *, complex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -264,7 +264,7 @@ int chetrd_fla(char *uplo, integer *n, complex *a, integer *lda, real *d__, real if (*info != 0) { i__1 = -(*info); - xerbla_("CHETRD", &i__1); + xerbla_("CHETRD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/cungtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/cungtr_fla.c index afc5060a9..ce635147a 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/cungtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/cungtr_fla.c @@ -124,7 +124,7 @@ int cungtr_fla(char *uplo, integer *n, complex *a, integer *lda, complex *tau, c integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cungql_(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *), cungqr_fla(integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, integer *); @@ -209,7 +209,7 @@ int cungtr_fla(char *uplo, integer *n, complex *a, integer *lda, complex *tau, c if (*info != 0) { i__1 = -(*info); - xerbla_("CUNGTR", &i__1); + xerbla_("CUNGTR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/cunmtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/cunmtr_fla.c index 963b9e842..f238ba306 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/cunmtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/cunmtr_fla.c @@ -182,7 +182,7 @@ int cunmtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, comp integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int cunmql_(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *), cunmqr_fla(char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); @@ -303,7 +303,7 @@ int cunmtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, comp if (*info != 0) { i__2 = -(*info); - xerbla_("CUNMTR", &i__2); + xerbla_("CUNMTR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/dorgtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/dorgtr_fla.c index f4e0c4e0f..cd80d08ad 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/dorgtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/dorgtr_fla.c @@ -124,7 +124,7 @@ int dorgtr_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dorgql_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), lapack_dorgqr(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); @@ -208,7 +208,7 @@ int dorgtr_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DORGTR", &i__1); + xerbla_("DORGTR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/dormtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/dormtr_fla.c index 6f5c11958..bf3ae556c 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/dormtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/dormtr_fla.c @@ -181,7 +181,7 @@ int dormtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, doub integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int dormql_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dormqr_fla(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *); @@ -301,7 +301,7 @@ int dormtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, doub if (*info != 0) { i__2 = -(*info); - xerbla_("DORMTR", &i__2); + xerbla_("DORMTR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/dsytd2_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/dsytd2_fla.c index cbcb40b5a..5e3b68381 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/dsytd2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/dsytd2_fla.c @@ -182,7 +182,7 @@ int dsytd2_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *); logical upper; extern /* Subroutine */ - int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer * ); + int dsymv_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -229,7 +229,7 @@ int dsytd2_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTD2", &i__1); + xerbla_("DSYTD2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/dsytrd_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/dsytrd_fla.c index 7a1cf8deb..2e1e61364 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/dsytrd_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/dsytrd_fla.c @@ -200,7 +200,7 @@ int dsytrd_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int dsytd2_fla(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dsyr2k_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlatrd_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *); + int dsytd2_fla(char *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), dsyr2k_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *), dlatrd_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer ldwork, lwkopt; logical lquery; @@ -263,7 +263,7 @@ int dsytrd_fla(char *uplo, integer *n, doublereal *a, integer * lda, doublereal if (*info != 0) { i__1 = -(*info); - xerbla_("DSYTRD", &i__1); + xerbla_("DSYTRD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/sorgtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/sorgtr_fla.c index 2513f9db5..cd7345e03 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/sorgtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/sorgtr_fla.c @@ -124,7 +124,7 @@ int sorgtr_fla(char *uplo, integer *n, real *a, integer *lda, real *tau, real *w integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sorgql_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), sorgqr_fla( integer *, integer *, integer *, real *, integer *, real *, real * , integer *, integer *); @@ -208,7 +208,7 @@ int sorgtr_fla(char *uplo, integer *n, real *a, integer *lda, real *tau, real *w if (*info != 0) { i__1 = -(*info); - xerbla_("SORGTR", &i__1); + xerbla_("SORGTR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/sormtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/sormtr_fla.c index 63e5e1009..501b1bbf4 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/sormtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/sormtr_fla.c @@ -182,7 +182,7 @@ int sormtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, real integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int sormql_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *); @@ -304,7 +304,7 @@ int sormtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, real if (*info != 0) { i__2 = -(*info); - xerbla_("SORMTR", &i__2); + xerbla_("SORMTR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/ssytd2_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/ssytd2_fla.c index fe99aa1e4..f04636d5d 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/ssytd2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/ssytd2_fla.c @@ -180,7 +180,7 @@ int ssytd2_fla(char *uplo, integer *n, real *a, integer *lda, real *d__, real *e extern logical lsame_(char *, char *); logical upper; extern /* Subroutine */ - int saxpy_(integer *, real *, real *, integer *, real *, integer *), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(char *, integer *), slarfg_(integer *, real *, real *, integer *, real *); + int saxpy_(integer *, real *, real *, integer *, real *, integer *), ssymv_(char *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), slarfg_(integer *, real *, real *, integer *, real *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -227,7 +227,7 @@ int ssytd2_fla(char *uplo, integer *n, real *a, integer *lda, real *d__, real *e if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTD2", &i__1); + xerbla_("SSYTD2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/ssytrd_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/ssytrd_fla.c index 43a72f683..a7fde7185 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/ssytrd_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/ssytrd_fla.c @@ -200,7 +200,7 @@ int ssytrd_fla(char *uplo, integer *n, real *a, integer *lda, real *d__, real *e integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int ssytd2_fla(char *, integer *, real *, integer *, real *, real *, real *, integer *), ssyr2k_(char *, char * , integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_( char *, integer *); + int ssytd2_fla(char *, integer *, real *, integer *, real *, real *, real *, integer *), ssyr2k_(char *, char * , integer *, integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int slatrd_(char *, integer *, integer *, real *, integer *, real *, real *, real *, integer *); @@ -265,7 +265,7 @@ int ssytrd_fla(char *uplo, integer *n, real *a, integer *lda, real *d__, real *e if (*info != 0) { i__1 = -(*info); - xerbla_("SSYTRD", &i__1); + xerbla_("SSYTRD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/zhetd2_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/zhetd2_fla.c index e5f2999e2..85d9a8757 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/zhetd2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/zhetd2_fla.c @@ -190,7 +190,7 @@ int zhetd2_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublerea int zhemv_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); logical upper; extern /* Subroutine */ - int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_( char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); + int zaxpy_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len), zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); /* -- LAPACK computational routine (version 3.4.2) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ @@ -237,7 +237,7 @@ int zhetd2_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETD2", &i__1); + xerbla_("ZHETD2", &i__1, (ftnlen)6); return 0; } /* Quick return if possible */ diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/zhetrd_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/zhetrd_fla.c index e36cd2650..1330b691f 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/zhetrd_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/zhetrd_fla.c @@ -200,7 +200,7 @@ int zhetrd_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublerea integer nbmin, iinfo; logical upper; extern /* Subroutine */ - int zhetd2_fla(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(char *, integer *); + int zhetd2_fla(char *, integer *, doublecomplex *, integer *, doublereal *, doublereal *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, integer *), xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern /* Subroutine */ int zlatrd_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *, doublecomplex *, doublecomplex *, integer *); @@ -266,7 +266,7 @@ int zhetrd_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublerea if (*info != 0) { i__1 = -(*info); - xerbla_("ZHETRD", &i__1); + xerbla_("ZHETRD", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/zungtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/zungtr_fla.c index af8113117..e6ca9023e 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/zungtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/zungtr_fla.c @@ -124,7 +124,7 @@ int zungtr_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -209,7 +209,7 @@ int zungtr_fla(char *uplo, integer *n, doublecomplex *a, integer *lda, doublecom if (*info != 0) { i__1 = -(*info); - xerbla_("ZUNGTR", &i__1); + xerbla_("ZUNGTR", &i__1, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/hetd/zunmtr_fla.c b/src/map/lapack2flamec/f2c/flamec/hetd/zunmtr_fla.c index 3daa14d9c..82a773087 100644 --- a/src/map/lapack2flamec/f2c/flamec/hetd/zunmtr_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/hetd/zunmtr_fla.c @@ -181,7 +181,7 @@ int zunmtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, doub integer iinfo; logical upper; extern /* Subroutine */ - int xerbla_(char *, integer *); + int xerbla_(const char *srname, const integer *info, ftnlen srname_len); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); integer lwkopt; logical lquery; @@ -302,7 +302,7 @@ int zunmtr_fla(char *side, char *uplo, char *trans, integer *m, integer *n, doub if (*info != 0) { i__2 = -(*info); - xerbla_("ZUNMTR", &i__2); + xerbla_("ZUNMTR", &i__2, (ftnlen)6); return 0; } else if (lquery) diff --git a/src/map/lapack2flamec/f2c/flamec/spffrt/dspffrt2_fla.c b/src/map/lapack2flamec/f2c/flamec/spffrt/dspffrt2_fla.c index 1cab59773..e975636a5 100644 --- a/src/map/lapack2flamec/f2c/flamec/spffrt/dspffrt2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/spffrt/dspffrt2_fla.c @@ -5,6 +5,8 @@ #include "FLA_f2c.h" extern integer dspr_( char *, integer *, doublereal *, doublereal *, integer *, doublereal * ); +extern int dgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *beta, doublereal *c__, integer *ldc); + #ifdef FLA_ENABLE_BLAS_EXT_GEMMT extern integer dgemmt_( char *, char *, char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer * ); #endif @@ -162,6 +164,9 @@ void dsffrk2_fla( doublereal *au, integer *m, integer *n, integer *lda, doublere integer k, kc, kcn; integer c__1 = 1; doublereal r1; + extern int dger_(integer *m, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *a, integer *lda); + extern int dcopy_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy); + extern int dscal_(integer *n, doublereal *da, doublereal *dx, integer *incx); --au; --bt; diff --git a/src/map/lapack2flamec/f2c/flamec/spffrt/zspffrt2_fla.c b/src/map/lapack2flamec/f2c/flamec/spffrt/zspffrt2_fla.c index f28940376..54808f105 100644 --- a/src/map/lapack2flamec/f2c/flamec/spffrt/zspffrt2_fla.c +++ b/src/map/lapack2flamec/f2c/flamec/spffrt/zspffrt2_fla.c @@ -6,6 +6,8 @@ extern void z_div(doublecomplex *, doublecomplex *, doublecomplex *); extern int zspr_(char *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *); +extern int zgemm_(char *transa, char *transb, integer *m, integer * n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex * c__, integer *ldc); + #ifdef FLA_ENABLE_BLAS_EXT_GEMMT extern integer zgemmt_( char *, char *, char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer * ); #endif @@ -163,6 +165,9 @@ void zsffrk2_fla( doublecomplex *au, integer *m, integer *n, integer *lda, doubl integer c__1 = 1; doublecomplex r1; doublecomplex c_b1 = { 1., 0. }; + extern int zgeru_(integer *m, integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, doublecomplex *a, integer *lda); + extern int zcopy_(integer *n, doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy); + extern int zscal_(integer *n, doublecomplex *za, doublecomplex *zx, integer *incx); --au; --bt; @@ -377,6 +382,7 @@ int lzspr_( char *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, inte { integer incw = 1; integer k, kn, nz; + extern int zaxpy_(integer *n, doublecomplex *za, doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy); ap--; work--; diff --git a/src/map/lapack2flamec/f2c/install/static/aocl_set_progress.c b/src/map/lapack2flamec/f2c/install/static/aocl_set_progress.c index 01facef75..42d68e7e3 100644 --- a/src/map/lapack2flamec/f2c/install/static/aocl_set_progress.c +++ b/src/map/lapack2flamec/f2c/install/static/aocl_set_progress.c @@ -4,9 +4,9 @@ #include "FLA_f2c.h" -aocl_fla_progress_callback aocl_fla_progress_ptr = NULL; +volatile aocl_fla_progress_callback aocl_fla_progress_glb_ptr = NULL; void aocl_fla_set_progress(aocl_fla_progress_callback func) { - aocl_fla_progress_ptr = func; + aocl_fla_progress_glb_ptr = func; } \ No newline at end of file diff --git a/src/map/lapack2flamec/f2c/install/static/dlamch.c b/src/map/lapack2flamec/f2c/install/static/dlamch.c index db44cb9ef..3aee087ed 100644 --- a/src/map/lapack2flamec/f2c/install/static/dlamch.c +++ b/src/map/lapack2flamec/f2c/install/static/dlamch.c @@ -56,7 +56,7 @@ doublereal dlamch_(char *cmach) /* rmax = overflow threshold - (base**emax)*(1-eps) */ /* ===================================================================== */ - + rmach = 0.; /* Assume rounding, not chopping. Always. -- This is a comment from LAPACK. */ if (first) diff --git a/src/map/lapack2flamec/f2c/install/static/droundup_lwork.c b/src/map/lapack2flamec/f2c/install/static/droundup_lwork.c index a9c31d60d..e67c5fe9c 100644 --- a/src/map/lapack2flamec/f2c/install/static/droundup_lwork.c +++ b/src/map/lapack2flamec/f2c/install/static/droundup_lwork.c @@ -1,7 +1,6 @@ /* droundup_lwork.f -- translated by f2c (version 20190311). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "FLA_f2c.h" /* Table of constant values */ -static doublereal c_b2 = 0.; /* > \brief \b DROUNDUP_LWORK */ /* =========== DOCUMENTATION =========== */ /* Online html documentation available at */ diff --git a/src/map/lapack2flamec/f2c/install/static/iparmq.c b/src/map/lapack2flamec/f2c/install/static/iparmq.c index 2f1c0c114..b4364f829 100644 --- a/src/map/lapack2flamec/f2c/install/static/iparmq.c +++ b/src/map/lapack2flamec/f2c/install/static/iparmq.c @@ -234,6 +234,8 @@ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ + ns = 0; + nh = 0; if (*ispec == 15 || *ispec == 13 || *ispec == 16) { /* ==== Set the number simultaneous shifts ==== */ nh = *ihi - *ilo + 1; diff --git a/src/map/lapack2flamec/f2c/install/static/slamch.c b/src/map/lapack2flamec/f2c/install/static/slamch.c index 36ef0b394..355ab2ea0 100644 --- a/src/map/lapack2flamec/f2c/install/static/slamch.c +++ b/src/map/lapack2flamec/f2c/install/static/slamch.c @@ -56,7 +56,7 @@ real slamch_(char *cmach) /* rmax = overflow threshold - (base**emax)*(1-eps) */ /* ===================================================================== */ - + rmach = 0.; /* Assume rounding, not chopping. Always. -- This is a comment from LAPACK. */ if (first) diff --git a/src/map/lapack2flamec/f2c/install/static/xerbla.c b/src/map/lapack2flamec/f2c/install/static/xerbla.c index 1e7fbd534..af7cc9f85 100644 --- a/src/map/lapack2flamec/f2c/install/static/xerbla.c +++ b/src/map/lapack2flamec/f2c/install/static/xerbla.c @@ -8,7 +8,7 @@ /* Table of constant values */ -/* Subroutine */ int xerbla_(char *srname, integer *info) +/* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len) { /* -- LAPACK auxiliary routine (preliminary version) -- */ /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ diff --git a/src/map/lapack2flamec/f2c/install/static/xerbla_array.c b/src/map/lapack2flamec/f2c/install/static/xerbla_array.c index 07d0d3c12..5140c8479 100644 --- a/src/map/lapack2flamec/f2c/install/static/xerbla_array.c +++ b/src/map/lapack2flamec/f2c/install/static/xerbla_array.c @@ -118,7 +118,7 @@ array.f"> */ /* Local variables */ integer i__; - extern /* Subroutine */ int xerbla_(char *, integer *); + extern /* Subroutine */ int xerbla_(const char *srname, const integer *info, ftnlen srname_len); char srname[32]; @@ -157,7 +157,7 @@ array.f"> */ *(unsigned char *)&srname[i__ - 1] = *(unsigned char *)& srname_array__[i__]; } - xerbla_(srname, info); + xerbla_(srname, info, i__1); return 0; } /* xerbla_array__ */ diff --git a/src/map/lapack2flamec/f2c/install/util/f77_aloc.c b/src/map/lapack2flamec/f2c/install/util/f77_aloc.c index fcc643566..3e87d6af4 100644 --- a/src/map/lapack2flamec/f2c/install/util/f77_aloc.c +++ b/src/map/lapack2flamec/f2c/install/util/f77_aloc.c @@ -5,7 +5,7 @@ #include "stdio.h" static const integer memfailure = 3; -extern void exit_(integer*); +extern void exit_(const integer*); #ifdef __cplusplus extern "C" { diff --git a/src/map/lapack2flamec/f2c/install/util/io/f2c_types.h b/src/map/lapack2flamec/f2c/install/util/io/f2c_types.h index d5d685a12..f5385e320 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/f2c_types.h +++ b/src/map/lapack2flamec/f2c/install/util/io/f2c_types.h @@ -95,6 +95,14 @@ typedef doublereal (*D_fp)(...), (*E_fp)(...); typedef /* Complex */ void (*C_fp)(...); typedef /* Double Complex */ void (*Z_fp)(...); typedef logical (*L_fp)(...); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(doublecomplex *); +typedef logical (*L_fpz2)(doublecomplex *, doublecomplex *); typedef shortlogical (*K_fp)(...); typedef /* Character */ void (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); @@ -107,6 +115,14 @@ typedef doublereal (*D_fp)(), (*E_fp)(); typedef /* Complex */ void (*C_fp)(); typedef /* Double Complex */ void (*Z_fp)(); typedef logical (*L_fp)(); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(complex *); +typedef logical (*L_fpz2)(complex *, complex *); typedef shortlogical (*K_fp)(); typedef /* Character */ void (*H_fp)(); typedef /* Subroutine */ int (*S_fp)(); diff --git a/src/map/lapack2flamec/f2c/install/util/io/f2c_types_win.h b/src/map/lapack2flamec/f2c/install/util/io/f2c_types_win.h index d5d685a12..c227b7197 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/f2c_types_win.h +++ b/src/map/lapack2flamec/f2c/install/util/io/f2c_types_win.h @@ -95,6 +95,14 @@ typedef doublereal (*D_fp)(...), (*E_fp)(...); typedef /* Complex */ void (*C_fp)(...); typedef /* Double Complex */ void (*Z_fp)(...); typedef logical (*L_fp)(...); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(doublecomplex *); +typedef logical (*L_fpz2)(doublecomplex *, doublecomplex *); typedef shortlogical (*K_fp)(...); typedef /* Character */ void (*H_fp)(...); typedef /* Subroutine */ int (*S_fp)(...); @@ -107,6 +115,14 @@ typedef doublereal (*D_fp)(), (*E_fp)(); typedef /* Complex */ void (*C_fp)(); typedef /* Double Complex */ void (*Z_fp)(); typedef logical (*L_fp)(); +typedef logical (*L_fp1)(complex *); +typedef logical (*L_fp2)(complex *, complex *); +typedef logical (*L_fps2)(real *, real *); +typedef logical (*L_fps3)(real *, real *, real *); +typedef logical (*L_fpd2)(doublereal *, doublereal *); +typedef logical (*L_fpd3)(doublereal *, doublereal *, doublereal *); +typedef logical (*L_fpz1)(doublecomplex *); +typedef logical (*L_fpz2)(doublecomplex *, doublecomplex *); typedef shortlogical (*K_fp)(); typedef /* Character */ void (*H_fp)(); typedef /* Subroutine */ int (*S_fp)(); diff --git a/src/map/lapack2flamec/f2c/install/util/io/fmt.h b/src/map/lapack2flamec/f2c/install/util/io/fmt.h index b70b78424..f3347aa3a 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/fmt.h +++ b/src/map/lapack2flamec/f2c/install/util/io/fmt.h @@ -97,7 +97,7 @@ extern int f__scale; #ifdef __cplusplus } #endif -#define GET(x) if((x=(*f__getn)())<0) return(x) +#define GET(x) if((x=(*f__getn)())<0) { return(x); } #define VAL(x) (x!='\n'?x:' ') #define PUT(x) (*f__putn)(x) diff --git a/src/map/lapack2flamec/f2c/install/util/io/lread.c b/src/map/lapack2flamec/f2c/install/util/io/lread.c index 66599cdbb..65fd23df1 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/lread.c +++ b/src/map/lapack2flamec/f2c/install/util/io/lread.c @@ -350,7 +350,6 @@ static int nmL_getc(void) static int nmL_ungetc(int x, FILE *f) { - f = f; /* banish non-use warning */ return *--nmL_next = x; } diff --git a/src/map/lapack2flamec/f2c/install/util/io/open.c b/src/map/lapack2flamec/f2c/install/util/io/open.c index 4c0d61a7e..e40bd51aa 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/open.c +++ b/src/map/lapack2flamec/f2c/install/util/io/open.c @@ -244,7 +244,7 @@ integer f_open(olist *a) int fk_open(int seq, int fmt, ftnint n) { - char nbuf[10]; + char nbuf[17]; olist a; (void) sprintf(nbuf,"fort.%ld",(long)n); a.oerr=1; diff --git a/src/map/lapack2flamec/f2c/install/util/io/rdfmt.c b/src/map/lapack2flamec/f2c/install/util/io/rdfmt.c index 0b8fcfc85..46fd7a90e 100644 --- a/src/map/lapack2flamec/f2c/install/util/io/rdfmt.c +++ b/src/map/lapack2flamec/f2c/install/util/io/rdfmt.c @@ -249,9 +249,9 @@ static int rd_F(ufloat *p, int w, int d, ftnlen len) } while(ch == ' ') { blankdrop: - if (!w--) goto zero; GET(ch); } + if (!w--) { goto zero; } GET(ch); } while(ch == '0') - { if (!w--) goto zero; GET(ch); } + { if (!w--) { goto zero; } GET(ch); } if (ch == ' ' && f__cblank) goto blankdrop; scale1 = f__scale; diff --git a/test/aoclflaprogress/CMakeLists.txt b/test/aoclflaprogress/CMakeLists.txt index f4ebb539f..27fc0dc36 100644 --- a/test/aoclflaprogress/CMakeLists.txt +++ b/test/aoclflaprogress/CMakeLists.txt @@ -12,6 +12,14 @@ endif() target_link_libraries(test_libFLAME_aocl debug "${LDFLAGS}" "${CMAKE_PROJECT_NAME}" blas) target_link_libraries(test_libFLAME_aocl optimized "${LDFLAGS}" "${CMAKE_PROJECT_NAME}" blas) +if(NOT ENABLE_EMBED_AOCLUTILS) + target_link_libraries(test_libFLAME_aocl debug "${LDFLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + target_link_libraries(test_libFLAME_aocl optimized "${LDFLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + if(UNIX) + target_link_libraries(test_libFLAME_aocl "libstdc++.so") + endif() +endif() + if(BLAS_HEADER_PATH) target_include_directories(test_libFLAME_aocl PRIVATE ${BLAS_HEADER_PATH}) else(BLAS_HEADER_PATH) @@ -21,3 +29,18 @@ endif() target_include_directories(test_libFLAME_aocl PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/src) add_subdirectory(src) + +if(WIN32) + set(FLA_PROGRESS_EXE_LOCATION "${CMAKE_SOURCE_DIR}/bin") +else() + set(FLA_PROGRESS_EXE_LOCATION "${CMAKE_CURRENT_SOURCE_DIR}") +endif() +# Added aocl_fla_progress to ctest +if(WIN32) + set(FLA_PROGRESS_EXE_LOCATION ${CMAKE_SOURCE_DIR}/bin/${CMAKE_BUILD_TYPE}) +else() + set(FLA_PROGRESS_EXE_LOCATION ${CMAKE_CURRENT_SOURCE_DIR}) +endif() +add_test(NAME aocl_fla_progress_test + COMMAND $ + WORKING_DIRECTORY ${FLA_PROGRESS_EXE_LOCATION}) diff --git a/test/aoclflaprogress/Makefile b/test/aoclflaprogress/Makefile index 8403c3f17..1d194aa42 100644 --- a/test/aoclflaprogress/Makefile +++ b/test/aoclflaprogress/Makefile @@ -60,6 +60,10 @@ LIBBLAS := LIBLAPACK_PATH := $(INSTALL_LIBDIR) LIBLAPACK := +# +# ----- AOCL-Utils library path +# +LIBAOCLUTILS_LIBRARY_PATH := # @@ -90,7 +94,7 @@ $(TEST_OBJ_PATH)/%.o: $(TEST_SRC_PATH)/%.c $(CC) $(CFLAGS) -c $< -o $@ test_$(FNAME): $(TEST_OBJS) - $(LINKER) $(TEST_OBJS) $(LIBFLAME) $(LIBLAPACK) $(LIBBLAS) $(LDFLAGS) -o $(TEST_BIN) + $(LINKER) $(TEST_OBJS) $(LIBFLAME) $(LIBLAPACK) $(LIBBLAS) $(LIBAOCLUTILS_LIBRARY_PATH) $(LDFLAGS) -o $(TEST_BIN) clean: $(RM_F) $(TEST_OBJS) $(TEST_BIN) diff --git a/test/aoclflaprogress/README.txt b/test/aoclflaprogress/README.txt index a9eba4038..915997bdc 100644 --- a/test/aoclflaprogress/README.txt +++ b/test/aoclflaprogress/README.txt @@ -38,9 +38,12 @@ parameters | Purpose --------------------------------------------------------------------- api | Name of the API which is currently running lapi | Length of API/Operation string -progress | Linear progress made in current thread so far +progress | Linear progress made in current thread so far current_thread | Current thread id -total_threads | Total number of threads used to performance the operation +total_threads | Total number of threads in current team + +Note: In case of single-threaded AOCL-LAPACK, the values of "current_thread" and "total_threads" are set to 0 and 1 respectively. +As a result, the callback function cannot be used to monitor the thread ID and thread count of the application. Callback Registration: diff --git a/test/example/CMakeLists.txt b/test/example/CMakeLists.txt index cb8b1b192..22cc5a070 100644 --- a/test/example/CMakeLists.txt +++ b/test/example/CMakeLists.txt @@ -22,16 +22,16 @@ set(TEST_LAPACK_LIBNAME "${EXT_LAPACK_LIBNAME}" CACHE STRING "lapack library nam set(TEST_FLAME_HEADER_PATH "${EXT_FLAME_HEADER_PATH}" CACHE STRING "Flame header path") include_directories("${EXT_FLAME_HEADER_PATH}") -link_directories("${EXT_BLAS_LIBRARY_DEPENDENCY_PATH}" "${EXT_LAPACK_LIBRARY_PATH}") +link_directories("${EXT_BLAS_LIBRARY_DEPENDENCY_PATH}" "${EXT_LAPACK_LIBRARY_PATH}" "${AOCLUTILS_LIBRARY_PATH}") add_executable(${PROJECT_NAME} "") if(WIN32) - target_link_libraries(${PROJECT_NAME} debug "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "${EXT_BLAS_LIBNAME}") - target_link_libraries(${PROJECT_NAME} optimized "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "${EXT_BLAS_LIBNAME}") + target_link_libraries(${PROJECT_NAME} debug "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "${EXT_BLAS_LIBNAME}" "libaoclutils.lib") + target_link_libraries(${PROJECT_NAME} optimized "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "${EXT_BLAS_LIBNAME}" "libaoclutils.lib") elseif(UNIX) - target_link_libraries(${PROJECT_NAME} debug "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "-lstdc++" "${EXT_BLAS_LIBNAME}") - target_link_libraries(${PROJECT_NAME} optimized "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "-lstdc++" "${EXT_BLAS_LIBNAME}") + target_link_libraries(${PROJECT_NAME} debug "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "-lstdc++ -laoclutils" "${EXT_BLAS_LIBNAME}") + target_link_libraries(${PROJECT_NAME} optimized "${TEST_FLAGS}" "${EXT_LAPACK_LIBNAME}" "-lstdc++ -laoclutils" "${EXT_BLAS_LIBNAME}") endif() -target_sources(${PROJECT_NAME} PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/sample_dgetrf.c) \ No newline at end of file +target_sources(${PROJECT_NAME} PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/sample_dgetrf.c) diff --git a/test/example/ReadMe.txt b/test/example/ReadMe.txt index 7014b8a0e..ab36d23e5 100644 --- a/test/example/ReadMe.txt +++ b/test/example/ReadMe.txt @@ -1,5 +1,5 @@ -# LibFLAME Samples -This directory contains sample source files showing usage of LibFLAME library functions. +# AOCL-LAPACK Samples +This directory contains sample source files showing usage of AOCL-LAPACK library functions. Use the provided cmake script file "CMakeLists.txt" to compile and run the programs. Same cmake script can be used for both Linux and Windows platforms. @@ -13,14 +13,16 @@ script can be used for both Linux and Windows platforms. ``` cmake . -DEXT_BLAS_LIBRARY_DEPENDENCY_PATH=/path/to/blas/library -DEXT_LAPACK_LIBRARY_PATH=/path/to/libflame/library + -DAOCLUTILS_LIBRARY_PATH=/path/to/aoclutils/library -DEXT_BLAS_LIBNAME=blas_lib_name -DEXT_LAPACK_LIBNAME=libflame_lib_name -DEXT_FLAME_HEADER_PATH=/path/to/flame/header/file ``` eg: ``` cmake . -DEXT_BLAS_LIBRARY_DEPENDENCY_PATH=../../lib/ -DEXT_LAPACK_LIBRARY_PATH=../../lib - -DEXT_BLAS_LIBNAME=libblis-mt.a -DEXT_LAPACK_LIBNAME=libflame.a - --DEXT_FLAME_HEADER_PATH=../../include/ + -DAOCLUTILS_LIBRARY_PATH=/home/usr/aoclutils-install/lib + -DEXT_BLAS_LIBNAME=libblis-mt.a -DEXT_LAPACK_LIBNAME=libflame.a + -DEXT_FLAME_HEADER_PATH=../../include/ ``` 3. Compile the sample application diff --git a/test/legacyflame/CMakeLists.txt b/test/legacyflame/CMakeLists.txt index 6339528de..707c482f6 100644 --- a/test/legacyflame/CMakeLists.txt +++ b/test/legacyflame/CMakeLists.txt @@ -4,12 +4,20 @@ add_executable(test_libFLAME "") if(UNIX) - set(Legacy_Flame_FLAGS "-lm") + set(Legacy_Flame_FLAGS "-lm -lpthread") endif() add_definitions(-DBLIS1_FROM_LIBFLAME) target_link_libraries(test_libFLAME debug "${CMAKE_PROJECT_NAME}" "${Legacy_Flame_FLAGS}" blas) - target_link_libraries(test_libFLAME optimized "${Legacy_Flame_FLAGS}" "${CMAKE_PROJECT_NAME}" blas) + +if(NOT ENABLE_EMBED_AOCLUTILS) + target_link_libraries(test_libFLAME optimized "${Legacy_Flame_FLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + target_link_libraries(test_libFLAME debug "${CMAKE_PROJECT_NAME}" "${Legacy_Flame_FLAGS}" aoclutils) + if(UNIX) + target_link_libraries(test_libFLAME "libstdc++.so") + endif() +endif() + target_include_directories(test_libFLAME PRIVATE "${CMAKE_SOURCE_DIR}/${BASE_INC_PATH}" blas) target_include_directories(test_libFLAME PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/src) # to move executable to the legacy flame folder LINUX @@ -19,3 +27,14 @@ if(UNIX) endif() add_subdirectory(src) + +# Added Legacy Test to ctest +if(WIN32) + set(LEGACY_FLAME_EXE_LOCATION ${CMAKE_SOURCE_DIR}/bin/${CMAKE_BUILD_TYPE}) +else() + set(LEGACY_FLAME_EXE_LOCATION ${CMAKE_CURRENT_SOURCE_DIR}) +endif() + +add_test(NAME legacy_flame_test + COMMAND $ + WORKING_DIRECTORY ${LEGACY_FLAME_EXE_LOCATION}) diff --git a/test/legacyflame/Makefile b/test/legacyflame/Makefile index 8c5f06d61..a2d122f9b 100644 --- a/test/legacyflame/Makefile +++ b/test/legacyflame/Makefile @@ -62,6 +62,10 @@ LIBBLAS := LIBLAPACK_PATH := $(INSTALL_LIBDIR) LIBLAPACK := +# +# ----- AOCL-Utils library path +# +LIBAOCLUTILS_LIBRARY_PATH := # @@ -92,7 +96,7 @@ $(TEST_OBJ_PATH)/%.o: $(TEST_SRC_PATH)/%.c $(CC) $(CFLAGS) -c $< -o $@ test_$(FNAME): $(TEST_OBJS) - $(LINKER) $(TEST_OBJS) $(LIBFLAME) $(LIBLAPACK) $(LIBBLAS) $(LDFLAGS) -o $(TEST_BIN) + $(LINKER) $(TEST_OBJS) $(LIBFLAME) $(LIBLAPACK) $(LIBBLAS) $(LIBAOCLUTILS_LIBRARY_PATH) $(LDFLAGS) -o $(TEST_BIN) clean: $(RM_F) $(TEST_OBJS) $(TEST_BIN) diff --git a/test/legacyflame/src/test_ldlt2_nopiv_ps.c b/test/legacyflame/src/test_ldlt2_nopiv_ps.c index e96d27f4c..17c449374 100644 --- a/test/legacyflame/src/test_ldlt2_nopiv_ps.c +++ b/test/legacyflame/src/test_ldlt2_nopiv_ps.c @@ -496,7 +496,7 @@ void test_ldlt2_nopiv_ps_d( test_params_t *params ) free(od); free(ad); - + free(work); free(fod); } return; diff --git a/test/main/CMakeLists.txt b/test/main/CMakeLists.txt index be4a00c66..e3fb85f44 100644 --- a/test/main/CMakeLists.txt +++ b/test/main/CMakeLists.txt @@ -25,7 +25,7 @@ if(WIN32) set(TEST_FLAGS "${OpenMP_libomp_LIBRARY}") elseif(UNIX) set(OpenMP_libomp_LIBRARY "-fopenmp" CACHE STRING "openmp library path") - set(Test_C_Flags " -O2 -Wall -Wno-comment" CACHE STRING "C Flags") + set(Test_C_Flags " -std=c11 -D_GNU_SOURCE -O2 -Wall -Wno-comment" CACHE STRING "C Flags") set(Test_LD_Flags "-lm -lpthread" CACHE STRING "LD FLags") set(TEST_FLAGS "${OpenMP_libomp_LIBRARY} ${Test_C_Flags} ${Test_LD_Flags}") message(STATUS "${TEST_FLAGS}") @@ -80,10 +80,21 @@ add_executable("${PROJECT_NAME}" "") message("${CMAKE_BUILD_TYPE}") if(UNIX) + if(EXT_OPENMP_PATH) + target_link_libraries("${PROJECT_NAME}" PRIVATE "${LIBIOMP}" "${CMAKE_PROJECT_NAME}" blas) + endif() target_link_libraries("${PROJECT_NAME}" PRIVATE "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" blas) + if(NOT ENABLE_EMBED_AOCLUTILS) + target_link_libraries("${PROJECT_NAME}" PRIVATE "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + target_link_libraries("${PROJECT_NAME}" PRIVATE "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" "libstdc++.so") + endif() elseif(WIN32) target_link_libraries("${PROJECT_NAME}" debug "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" blas) target_link_libraries("${PROJECT_NAME}" optimized "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" blas) + if(NOT ENABLE_EMBED_AOCLUTILS) + target_link_libraries("${PROJECT_NAME}" debug "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + target_link_libraries("${PROJECT_NAME}" optimized "${TEST_FLAGS}" "${CMAKE_PROJECT_NAME}" aoclutils) + endif() endif() if(BLAS_HEADER_PATH) @@ -97,3 +108,6 @@ target_include_directories("${PROJECT_NAME}" PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} add_subdirectory(src) add_subdirectory(validate_src) + +include(main_ctest.cmake) +include(negative_test.cmake) diff --git a/test/main/Makefile b/test/main/Makefile index ad845db9a..3143fa463 100644 --- a/test/main/Makefile +++ b/test/main/Makefile @@ -10,22 +10,28 @@ LINKER := $(CC) RM_RF := rm -rf OMP_LIB := -fopenmp CPPFLAGS := -CFLAGS := -O2 -Wall -Wno-comment ${OMP_LIB} -LDFLAGS := -lm -lpthread $(OMP_LIB) +CFLAGS := -std=c11 -D_GNU_SOURCE -O2 -Wall -Wno-comment ${OMP_LIB} +LDFLAGS := -lstdc++ -lm -lpthread $(OMP_LIB) + +# +# --- LIBFLAME \ LAPACK library ------------------------------------------------ +# +LIB_PATH := ../../lib/x86_64-unknown-linux-gnu/ +LIBFLAME := $(LIB_PATH)/libflame.a +LAPACK_INC_PATH := ../../include/x86_64-unknown-linux-gnu/ # # --- BLAS library ------------------------------------------------------------- # # A BLAS library must be given in order to run the libflame test suite. -LIBBLAS := +LIBBLAS := BLAS_HEADER_PATH := # -# --- LIBFLAME library --------------------------------------------------------- +# ----- AOCL-Utils library path # -LIB_PATH := ../../lib/x86_64-unknown-linux-gnu/ -LIBFLAME := $(LIB_PATH)/libflame.a -LAPACK_INC_PATH := ../../include/x86_64-unknown-linux-gnu/ +LIBAOCLUTILS_LIBRARY_PATH := + # # --- Uncomment the four lines below and set MKLROOT & LDFLAGS ----------------- # appropriately to link to MKL libs @@ -36,7 +42,7 @@ LAPACK_INC_PATH := ../../include/x86_64-unknown-linux-gnu/ #LDFLAGS := -Wl,--start-group ${MKLROOT}/intel64/libmkl_intel_lp64.a \ ${MKLROOT}/intel64/libmkl_sequential.a \ ${MKLROOT}/intel64/libmkl_core.a -Wl,--end-group \ - -lpthread -lm -fopenmp -ldl + -lpthread -lm -fopenmp -ldl -lstdc++ # # --- ILP64 --- Set to 1 to enable ILP64 --------------------------------------- @@ -111,7 +117,7 @@ $(TEST_OBJ_PATH)/%.o: $(TEST_SRC_PATH)/%.c $(CC) $(CPPFLAGS) $(CFLAGS) -c $< -o $@ test_$(FNAME): $(TEST_VALIDATE_OBJS) $(TEST_OBJS) - $(LINKER) $(TEST_VALIDATE_OBJS) $(TEST_OBJS) $(LIBFLAME) $(LIBBLAS) \ + $(LINKER) $(TEST_VALIDATE_OBJS) $(TEST_OBJS) $(LIBFLAME) $(LIBBLAS) $(LIBAOCLUTILS_LIBRARY_PATH) \ $(LDFLAGS) -o $(TEST_BIN) clean: diff --git a/test/main/ReadMe.txt b/test/main/ReadMe.txt index 035f20160..ab8d36009 100644 --- a/test/main/ReadMe.txt +++ b/test/main/ReadMe.txt @@ -19,34 +19,31 @@ The test suite directory has (test/main) the following contents, ## Compiling -Before running the test suite, we must link BLAS and LAPACK library. +Before running the test suite, we must set BLAS, LAPACK and AOCL-Utils library paths. +BLAS library and header paths has to be set using 'LIBBLAS' and 'BLAS_HEADER_PATH' flags +respectively. AOCL-Utils library path has to be set using LIBAOCLUTILS_LIBRARY_PATH flag. + $ make BLAS_HEADER_PATH= + LIBBLAS= + LIBAOCLUTILS_LIBRARY_PATH= + By default, the make file is programmed to look for libflame.a in `../../lib/ x86_64-unknown-linux-gnu` directory for LAPACK library. However, if the users wish to link different LAPACK library, they must set the envrionment variable `LIB_PATH` to the install path and `LIBFLAME` to the LAPACK library name like the example given below. - $ export LIBFLAME=lapack.a LIB_PATH=/usr/local - $ make - Alternatively, you may set the `make` variable `LIB_PATH` on the command line as you execute `make`: - - $ make LIBFLAME=lapack.a LIB_PATH=/usr/local - - -Similarly, user has to provide the path for BLAS library and header by setting the -environment varaiable 'LIBBLAS' and 'BLAS_HEADER_PATH' respectively. - - $ make BLAS_HEADER_PATH= + $ make LIBFLAME=lapack.a LIB_PATH=/usr/local + BLAS_HEADER_PATH= LIBBLAS= + LIBAOCLUTILS_LIBRARY_PATH= When you are ready to compile, simply run `make` from the current directory. - After `make` is complete, an executable named `test_lapack.x` is created. There are different ways to use the executable to perform different tests as given below. @@ -75,13 +72,13 @@ below. ### `input.general.operations` The `input.general.operations` file also contains the list of all sub-groups of APIs - like all LIN,EIG etc. User can enable/disable the testing of a particular sub-group of - API's by setting/resetting the corresponding group's flag. - Below is the content in `input.general.operations` corresponding to subgroup testing. + like all LIN,EIG etc. User can enable/disable the testing of a particular sub-group + of API's by setting/resetting the corresponding group's flag. Below is the content + in `input.general.operations` corresponding to subgroup testing. - 1 LIN for testing all LIN API's (0 = disable; 1 = enable) - 1 EIG for testing all Eigen API's (0 = disable; 1 = enable) - 1 SVD for testing all SVD API's (0 = disable; 1 = enable) + 1 LIN for testing all LIN API's (0 = disable; 1 = enable) + 1 EIG for testing all Eigen API's (0 = disable; 1 = enable) + 1 SVD for testing all SVD API's (0 = disable; 1 = enable) Note: If any sub-group is enabled then individual API test will not execute. @@ -97,6 +94,16 @@ below. config files. Config files support providing input parameters for four tests. For each of the four tests, a range of input dimensions can be specified. + ## Running test with different config directory. + + This method can be used to test APIs with config files from any directory. + Name of the directory can be specified through command-line option --config_dir as + given below. + $ ./test_lapack.x --config-dir=weekly + Folder chosen for this option will be 'config/weekly' relative to the test-suite folder. + The default directory chosen when --config-dir option is not specified is 'config'. + + Note:Directory must be inside 'config' directory. 2. Command line tests @@ -105,7 +112,8 @@ below. command line arguments. For example, command-line options for the API GGEVX are: - ggevx + ggevx + Specific instances of calling GGEVX are: ./test_lapack.x GGEVX d P N N E 10 10 10 10 10 -1 100 @@ -132,8 +140,8 @@ below. 4. Tests from the DTL Logs - Execute run_tests_from_dtl_logs.py located under test/main/scripts folder with following - parameters as given below: + Execute run_tests_from_dtl_logs.py located under test/main/scripts folder with + following parameters as given below: --filename (required) // The filename or filepath of the DTL log files --apiname (optional) // To execute for Specific API with it's name @@ -144,12 +152,12 @@ below. $ run_tests_from_dtl_logs.py --filename="logs.txt" --apiname="ggevx" --nrepeats=4 To execute the test with thread safety, set the environment variable - OMP_NUM_THREADS to a value greater than 1. + FLA_TEST_NUM_THREADS to a value greater than 1. For windows system you need to set the environment variable using the set command and then need to execute the script. - > set OMP_NUM_THREADS=4 + > set FLA_TEST_NUM_THREADS=4 > run_tests_from_dtl_logs.py --filename="logs.txt" For linux system you can set the environment variable along with the execution of the command @@ -163,7 +171,6 @@ below. Windows -- FLA_MEM_UNALIGNED is set, unaligned memory is allocated Linux -- MEM_UNALN=1 - ## Enabling non-default API naming convention in testsuite: LAPACK's default API naming convention is lowercase with underscore. (Ex: getrf_ ) @@ -172,9 +179,7 @@ below. in test/main/Makefile. Testsuite default calling convention is lower_ - NOTE: - To execute test on windows, its recommended to keep the following in same path/folder: 1) libflame binary(AOCL-LibFlame-Win-MT-dll or -lib) @@ -186,3 +191,70 @@ NOTE: To execute the test using libflame shared/dynamic binary, AOCL-LibBlis-Win-MT-dll should be in the same path along with the above files. +6. Tests with invalid input parameters using --einfo option: + +   Tests to check proper functioning of APIs while sending invalid value for any of the input parameters +   can be done using --einfo option. This option is available only through command-line execution. + +   Example: +    ./test_lapack.x GGEVX d P N N E -10 10 10 10 10 -1 100 --einfo=-5 + +   In the above example, the value of the M has been given -10 which is an invalid value. +   The --einfo parameter states the expected value of 'info' coming out of GGEVX API given the invalid input. +   The test-suite checks the actual value of 'info' against this expected value and reurns PASS if they match +   and FAIL if they don't. + +   All parameter related testing commands are compiled in test/main/scripts run_negative_test_cases.py which +   can be used for this purpose. + +7. Tests with special inputs using --imatrix option: + + Test the API's by intializing matrix with special input values such as NAN or INFINITY using --imatrix. + This option is available only through command line execution. + + Example: + ./test_lapack.x GETRF d 10 10 10 1 --imatrix=N + ./test_lapack.x GETRF d 10 10 10 1 --imatrix=I + + In the above example passing the value of --imatrix as 'N' will intialize the matrix with NAN values + and if the value is 'I' then matrix will be intialized with the INFINITY. + +8. Tests with -1 for leading dimensions from config files + + When -1 is passed as any of the leading dimensions(lda, ldab, ldu, ldvt, ldz etc) from config files, + least valid value is assigned to the corresponding leading dimension. + + Example: If lda = -1 passed(from config file) to test_geev API + then main test-suite sets lda = fla_max(1,n) before calling lapack API geev. + + If lda = -1 is passed through command line, then -1 will be taken as the given lda + without any change. + +9. AOCL_FLA_PROGRESS feature test. + + Enable a macro 'AOCL_FLA_SET_PROGRESS_ENABLE' for aocl progress and build libflame main test suite for sequential/multithread and run the + executable. + + For testing sequential mode : ./test_lapack.x + + output: + In AOCL Progress thread 0, at API DGETRF, progress 8 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 16 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 24 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 32 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 40 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 48 total threads= 1 + In AOCL Progress thread 0, at API DGETRF, progress 56 total threads= 1 + + For testing multithread mode: FLA_TEST_NUM_THREADS=4 ./test_lapack.x + + output: + In AOCL Progress thread 1, at API DGETRF, progress 8 total threads= 4 + In AOCL Progress thread 1, at API DGETRF, progress 16 total threads= 4 + In AOCL Progress thread 2, at API DGETRF, progress 8 total threads= 4 + In AOCL Progress thread 1, at API DGETRF, progress 24 total threads= 4 + In AOCL Progress thread 2, at API DGETRF, progress 16 total threads= 4 + In AOCL Progress thread 1, at API DGETRF, progress 32 total threads= 4 + In AOCL Progress thread 3, at API DGETRF, progress 8 total threads= 4 + In AOCL Progress thread 2, at API DGETRF, progress 24 total threads= 4 + In AOCL Progress thread 0, at API DGETRF, progress 8 total threads= 4 diff --git a/test/main/config/long/AUX_PARAMS.dat b/test/main/config/long/AUX_PARAMS.dat new file mode 100644 index 000000000..61600bef0 --- /dev/null +++ b/test/main/config/long/AUX_PARAMS.dat @@ -0,0 +1,14 @@ +Num_Tests 4 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +incx 1 -1 3 3 +incy 1 -1 -1 3 +Repeats 5 4 3 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +threshold 3.0 3.0 3.0 3.0 diff --git a/test/main/config/EIG_NSYM_PARAMS.dat b/test/main/config/long/EIG_NSYM_PARAMS.dat similarity index 94% rename from test/main/config/EIG_NSYM_PARAMS.dat rename to test/main/config/long/EIG_NSYM_PARAMS.dat index 9b4610f52..3d4ae4e5b 100644 --- a/test/main/config/EIG_NSYM_PARAMS.dat +++ b/test/main/config/long/EIG_NSYM_PARAMS.dat @@ -5,10 +5,10 @@ MRange_step_size 10 20 NRange_start 15 89 NRange_end 35 240 NRange_step_size 10 100 -lda 20 87 -ldb 20 87 -ldvl 20 87 -ldvr 20 87 +lda -1 87 +ldb -1 87 +ldvl -1 87 +ldvr -1 87 Repeats 5 4 3 2 DataTypes s d c z Matrix_Layout 101 102 101 102 diff --git a/test/main/config/long/EIG_PARAMS.dat b/test/main/config/long/EIG_PARAMS.dat new file mode 100644 index 000000000..32d275b10 --- /dev/null +++ b/test/main/config/long/EIG_PARAMS.dat @@ -0,0 +1,48 @@ +Num_Tests 4 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 140 250 +NRange_end 100 500 200 500 +NRange_step_size 15 130 250 160 +Repeats 5 4 3 2 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +Trans N T C T +Uplo U L U L +Job N P S B +Jobz N V N V +job_seqr E S E S +Vect Q P Q P +nrhs 1 3 2 4 +lda -1 300 1600 3000 +ldb -1 300 1600 3000 +ldz -1 300 1600 3000 +ldq -1 300 1600 3000 +nb 10 30 60 100 +ldt 10 30 60 100 +K 5 10 20 40 +isgn 1 1 -1 -1 +compq_hgeqz N V N I +compz_hgeqz N V N I +compz N V I N +compz_hseqr N V N I +kb 2 7 1 3 +itype 1 2 3 2 +vect_rd V N U V +side L R L R +eigsrc Q N Q N +initv N U N U +norm M 1 I F +diag N U N U +storev C C R R +tsize -1 -2 -1 -2 +ilo 2 1 500 1500 +ihi 7 100 750 1750 +range_x A A V I +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +abstol -1 -1 -1 -1 +threshold_value 20 20 20 20 diff --git a/test/main/config/long/LIN_SLVR.dat b/test/main/config/long/LIN_SLVR.dat new file mode 100644 index 000000000..110cdf564 --- /dev/null +++ b/test/main/config/long/LIN_SLVR.dat @@ -0,0 +1,38 @@ +Num_Tests 3 +MRange_start 10 67 100 +MRange_end 20 99 400 +MRange_step_size 10 20 100 +NRange_start 15 89 85 +NRange_end 35 240 385 +NRange_step_size 10 100 100 +lda -1 87 400 +ldb -1 87 400 +ldz -1 87 400 +ldq -1 87 400 +ldab 20 30 400 200 +Repeats 5 4 3 2 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +trans N T N T +uplo L U U L +compq_gghrd V I V +compz_gghrd V I V +nrhs 1 3 2 4 +ncolm 1 5 10 25 +kl 2 7 1 3 +ku 3 8 2 5 +kd 2 7 5 30 +diag N N N N +fact F E N E +equed N N N N +Symm S H S H +equed_porfsx N N N N +n_err_bnds_porfsx 3 3 3 3 +nparams_porfsx 3 3 3 3 +norm_gbcon 1 O I 1 +kl_gbcon 1 2 3 27 +ku_gbcon 2 3 8 35 +ldab_gbcon 4 7 15 65 +ilo 2 40 1 +ihi 6 55 100 +RSEE_Threshold 10.0 10.0 20.0 50.0 diff --git a/test/main/config/SVD.dat b/test/main/config/long/SVD.dat similarity index 89% rename from test/main/config/SVD.dat rename to test/main/config/long/SVD.dat index 5ebb1e5cd..991e5f8e9 100644 --- a/test/main/config/SVD.dat +++ b/test/main/config/long/SVD.dat @@ -5,9 +5,9 @@ MRange_step_size 10 100 200 1000 NRange_start 5 120 1400 2500 NRange_end 100 1000 2000 5000 NRange_step_size 15 130 250 1600 -lda 20 300 1400 3000 -ldu 20 300 1400 3000 -ldvt 100 1000 2000 5000 +lda -1 300 1400 3000 +ldu -1 300 1400 3000 +ldvt -1 1000 2000 5000 Repeats 5 4 3 2 DataTypes s d c z Matrix_Layout 101 102 101 102 diff --git a/test/main/config/medium/AUX_PARAMS.dat b/test/main/config/medium/AUX_PARAMS.dat new file mode 100644 index 000000000..86683c9ff --- /dev/null +++ b/test/main/config/medium/AUX_PARAMS.dat @@ -0,0 +1,14 @@ +Num_Tests 4 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +incx 1 -1 3 3 +incy 1 -1 -1 3 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +threshold 3.0 3.0 3.0 3.0 diff --git a/test/main/config/medium/EIG_NSYM_PARAMS.dat b/test/main/config/medium/EIG_NSYM_PARAMS.dat new file mode 100644 index 000000000..bcabaedda --- /dev/null +++ b/test/main/config/medium/EIG_NSYM_PARAMS.dat @@ -0,0 +1,44 @@ +Num_Tests 2 +MRange_start 10 67 +MRange_end 20 99 +MRange_step_size 10 20 +NRange_start 15 89 +NRange_end 35 240 +NRange_step_size 10 100 +lda -1 87 +ldb -1 87 +ldvl -1 87 +ldvr -1 87 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +howmny A B S B +initv N U N U +job_seqr E S E S +eigsrc Q N Q N +side L R L R +job E V B B +howmny_trsna A S A A +job_trsen N E V B +compq V V V N +trana_real N T N T +trana_complex N T C T +tranb_real N T T N +tranb_complex N T T C +isgn 1 -1 -1 1 +gghrd_threshold 10.0 10.0 10.0 10.0 +ggbal_threshold 10.0 10.0 10.0 10.0 +GNSEP_threshold 5.0 10.0 20.0 30.0 +side_tgevc L R B B +jobvsl N V V V +jobvsr V N V V +sort_gges N N N N +sense_ggsex N N N N +balance_ggevx N P S B +sense_ggevx N E V B +sort_gees N N N N +wantz 0 1 1 1 +wantq 1 0 1 1 +ijob 0 1 2 3 +unmhr_trans N C N C + diff --git a/test/main/config/EIG_PARAMS.dat b/test/main/config/medium/EIG_PARAMS.dat similarity index 76% rename from test/main/config/EIG_PARAMS.dat rename to test/main/config/medium/EIG_PARAMS.dat index e4fee9e19..0acfbc73c 100644 --- a/test/main/config/EIG_PARAMS.dat +++ b/test/main/config/medium/EIG_PARAMS.dat @@ -5,7 +5,7 @@ MRange_step_size 10 100 200 1000 NRange_start 5 120 140 250 NRange_end 100 500 200 500 NRange_step_size 15 130 250 160 -Repeats 5 4 3 2 +Repeats 1 1 1 1 DataTypes s d c z Matrix_Layout 101 102 101 102 Trans N T C T @@ -15,10 +15,10 @@ Jobz N V N V job_seqr E S E S Vect Q P Q P nrhs 1 3 2 4 -lda 20 300 1600 3000 -ldb 20 300 1600 3000 -ldz 20 300 1600 3000 -ldq 20 300 1600 3000 +lda -1 300 1600 3000 +ldb -1 300 1600 3000 +ldz -1 300 1600 3000 +ldq -1 300 1600 3000 nb 10 30 60 100 ldt 10 30 60 100 K 5 10 20 40 @@ -39,4 +39,10 @@ storev C C R R tsize -1 -2 -1 -2 ilo 2 1 500 1500 ihi 7 100 750 1750 +range_x A A V I +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +abstol -1 -1 -1 -1 threshold_value 20 20 20 20 \ No newline at end of file diff --git a/test/main/config/LIN_SLVR.dat b/test/main/config/medium/LIN_SLVR.dat similarity index 91% rename from test/main/config/LIN_SLVR.dat rename to test/main/config/medium/LIN_SLVR.dat index 875816108..f936e1bf2 100644 --- a/test/main/config/LIN_SLVR.dat +++ b/test/main/config/medium/LIN_SLVR.dat @@ -5,10 +5,10 @@ MRange_step_size 10 20 100 NRange_start 15 89 85 NRange_end 35 240 385 NRange_step_size 10 100 100 -lda 20 87 400 -ldb 20 87 400 -ldz 20 87 400 -ldq 20 87 400 +lda -1 87 400 +ldb -1 87 400 +ldz -1 87 400 +ldq -1 87 400 ldab 20 30 400 200 Repeats 1 1 1 1 DataTypes s d c z diff --git a/test/main/config/medium/SVD.dat b/test/main/config/medium/SVD.dat new file mode 100644 index 000000000..c9ab130d2 --- /dev/null +++ b/test/main/config/medium/SVD.dat @@ -0,0 +1,49 @@ +Num_Tests 4 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +ldu -1 300 1400 3000 +ldvt -1 1000 2000 5000 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +jobu U N U N +jobv V N V N +jobq Q N Q N +m 10 50 100 200 +p 12 40 100 150 +n 15 40 110 130 +tola 1.0 2.0 3.0 +tolb 2.0 2.0 1.0 +jobu_gesvd N A S O +jobvt_gesvd O A S N +joba_gejsv C E F G +jobu_gejsv U F W N +jobv_gejsv V J W N +jobr_gejsv N R N R +jobt_gejsv T N T N +jobp_gejsv P N P N +m_gejsv 15 40 110 200 +n_gejsv 10 30 100 160 +joba_jesvj L U G U +jobu_jesvj U C N U +jobv_jesvj V A N A +m_jesvj 15 40 110 400 +n_jesvj 10 30 100 160 +mv_jesvj 10 25 90 100 +ctol_jesvj 1.5 2.0 2.0 1.0 +jobu_gesvdx N V V V +jobvt_gesvdx V N V V +range_gesvdx A V I A +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +joba_gesvdq A H M E +jobu_gesvdq A S R N +jobv_gesvdq A V R N +threshold 3.0 5.0 20.0 40.0 diff --git a/test/main/config/micro/AUX_PARAMS.dat b/test/main/config/micro/AUX_PARAMS.dat new file mode 100644 index 000000000..c4ca3a07d --- /dev/null +++ b/test/main/config/micro/AUX_PARAMS.dat @@ -0,0 +1,14 @@ +Num_Tests 2 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +incx 1 -1 3 3 +incy 1 -1 -1 3 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +threshold 3.0 3.0 3.0 3.0 diff --git a/test/main/config/micro/EIG_NSYM_PARAMS.dat b/test/main/config/micro/EIG_NSYM_PARAMS.dat new file mode 100644 index 000000000..e3ad5a40a --- /dev/null +++ b/test/main/config/micro/EIG_NSYM_PARAMS.dat @@ -0,0 +1,44 @@ +Num_Tests 1 +MRange_start 10 67 +MRange_end 20 99 +MRange_step_size 10 20 +NRange_start 15 89 +NRange_end 35 240 +NRange_step_size 10 100 +lda -1 87 +ldb -1 87 +ldvl -1 87 +ldvr -1 87 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +howmny A B S B +initv N U N U +job_seqr E S E S +eigsrc Q N Q N +side L R L R +job E V B B +howmny_trsna A S A A +job_trsen N E V B +compq V V V N +trana_real N T N T +trana_complex N T C T +tranb_real N T T N +tranb_complex N T T C +isgn 1 -1 -1 1 +gghrd_threshold 10.0 10.0 10.0 10.0 +ggbal_threshold 10.0 10.0 10.0 10.0 +GNSEP_threshold 5.0 10.0 20.0 30.0 +side_tgevc L R B B +jobvsl N V V V +jobvsr V N V V +sort_gges N N N N +sense_ggsex N N N N +balance_ggevx N P S B +sense_ggevx N E V B +sort_gees N N N N +wantz 0 1 1 1 +wantq 1 0 1 1 +ijob 0 1 2 3 +unmhr_trans N C N C + diff --git a/test/main/config/micro/EIG_PARAMS.dat b/test/main/config/micro/EIG_PARAMS.dat new file mode 100644 index 000000000..5a2130fe2 --- /dev/null +++ b/test/main/config/micro/EIG_PARAMS.dat @@ -0,0 +1,48 @@ +Num_Tests 1 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 140 250 +NRange_end 100 500 200 500 +NRange_step_size 15 130 250 160 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +Trans N T C T +Uplo U L U L +Job N P S B +Jobz N V N V +job_seqr E S E S +Vect Q P Q P +nrhs 1 3 2 4 +lda -1 300 1600 3000 +ldb -1 300 1600 3000 +ldz -1 300 1600 3000 +ldq -1 300 1600 3000 +nb 10 30 60 100 +ldt 10 30 60 100 +K 5 10 20 40 +isgn 1 1 -1 -1 +compq_hgeqz N V N I +compz_hgeqz N V N I +compz N V I N +compz_hseqr N V N I +kb 2 7 1 3 +itype 1 2 3 2 +vect_rd V N U V +side L R L R +eigsrc Q N Q N +initv N U N U +norm M 1 I F +diag N U N U +storev C C R R +tsize -1 -2 -1 -2 +ilo 2 1 500 1500 +ihi 7 100 750 1750 +range_x A A V I +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +abstol -1 -1 -1 -1 +threshold_value 20 20 20 20 diff --git a/test/main/config/micro/LIN_SLVR.dat b/test/main/config/micro/LIN_SLVR.dat new file mode 100644 index 000000000..a50a15e6e --- /dev/null +++ b/test/main/config/micro/LIN_SLVR.dat @@ -0,0 +1,38 @@ +Num_Tests 1 +MRange_start 10 67 100 +MRange_end 20 99 400 +MRange_step_size 10 20 100 +NRange_start 15 89 85 +NRange_end 35 240 385 +NRange_step_size 10 100 100 +lda -1 87 400 +ldb -1 87 400 +ldz -1 87 400 +ldq -1 87 400 +ldab 20 30 400 200 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +trans N T N T +uplo L U U L +compq_gghrd V I V +compz_gghrd V I V +nrhs 1 3 2 4 +ncolm 1 5 10 25 +kl 2 7 1 3 +ku 3 8 2 5 +kd 2 7 5 30 +diag N N N N +fact F E N E +equed N N N N +Symm S H S H +equed_porfsx N N N N +n_err_bnds_porfsx 3 3 3 3 +nparams_porfsx 3 3 3 3 +norm_gbcon 1 O I 1 +kl_gbcon 1 2 3 27 +ku_gbcon 2 3 8 35 +ldab_gbcon 4 7 15 65 +ilo 2 40 1 +ihi 6 55 100 +RSEE_Threshold 10.0 10.0 20.0 50.0 diff --git a/test/main/config/micro/SVD.dat b/test/main/config/micro/SVD.dat new file mode 100644 index 000000000..9583a121a --- /dev/null +++ b/test/main/config/micro/SVD.dat @@ -0,0 +1,49 @@ +Num_Tests 1 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +ldu -1 300 1400 3000 +ldvt -1 1000 2000 5000 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +jobu U N U N +jobv V N V N +jobq Q N Q N +m 10 50 100 200 +p 12 40 100 150 +n 15 40 110 130 +tola 1.0 2.0 3.0 +tolb 2.0 2.0 1.0 +jobu_gesvd N A S O +jobvt_gesvd O A S N +joba_gejsv C E F G +jobu_gejsv U F W N +jobv_gejsv V J W N +jobr_gejsv N R N R +jobt_gejsv T N T N +jobp_gejsv P N P N +m_gejsv 15 40 110 200 +n_gejsv 10 30 100 160 +joba_jesvj L U G U +jobu_jesvj U C N U +jobv_jesvj V A N A +m_jesvj 15 40 110 400 +n_jesvj 10 30 100 160 +mv_jesvj 10 25 90 100 +ctol_jesvj 1.5 2.0 2.0 1.0 +jobu_gesvdx N V V V +jobvt_gesvdx V N V V +range_gesvdx A V I A +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +joba_gesvdq A H M E +jobu_gesvdq A S R N +jobv_gesvdq A V R N +threshold 3.0 5.0 20.0 40.0 diff --git a/test/main/config/short/AUX_PARAMS.dat b/test/main/config/short/AUX_PARAMS.dat new file mode 100644 index 000000000..c4ca3a07d --- /dev/null +++ b/test/main/config/short/AUX_PARAMS.dat @@ -0,0 +1,14 @@ +Num_Tests 2 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +incx 1 -1 3 3 +incy 1 -1 -1 3 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +threshold 3.0 3.0 3.0 3.0 diff --git a/test/main/config/short/EIG_NSYM_PARAMS.dat b/test/main/config/short/EIG_NSYM_PARAMS.dat new file mode 100644 index 000000000..bcabaedda --- /dev/null +++ b/test/main/config/short/EIG_NSYM_PARAMS.dat @@ -0,0 +1,44 @@ +Num_Tests 2 +MRange_start 10 67 +MRange_end 20 99 +MRange_step_size 10 20 +NRange_start 15 89 +NRange_end 35 240 +NRange_step_size 10 100 +lda -1 87 +ldb -1 87 +ldvl -1 87 +ldvr -1 87 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +howmny A B S B +initv N U N U +job_seqr E S E S +eigsrc Q N Q N +side L R L R +job E V B B +howmny_trsna A S A A +job_trsen N E V B +compq V V V N +trana_real N T N T +trana_complex N T C T +tranb_real N T T N +tranb_complex N T T C +isgn 1 -1 -1 1 +gghrd_threshold 10.0 10.0 10.0 10.0 +ggbal_threshold 10.0 10.0 10.0 10.0 +GNSEP_threshold 5.0 10.0 20.0 30.0 +side_tgevc L R B B +jobvsl N V V V +jobvsr V N V V +sort_gges N N N N +sense_ggsex N N N N +balance_ggevx N P S B +sense_ggevx N E V B +sort_gees N N N N +wantz 0 1 1 1 +wantq 1 0 1 1 +ijob 0 1 2 3 +unmhr_trans N C N C + diff --git a/test/main/config/short/EIG_PARAMS.dat b/test/main/config/short/EIG_PARAMS.dat new file mode 100644 index 000000000..f825616c0 --- /dev/null +++ b/test/main/config/short/EIG_PARAMS.dat @@ -0,0 +1,48 @@ +Num_Tests 2 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 140 250 +NRange_end 100 500 200 500 +NRange_step_size 15 130 250 160 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +Trans N T C T +Uplo U L U L +Job N P S B +Jobz N V N V +job_seqr E S E S +Vect Q P Q P +nrhs 1 3 2 4 +lda -1 300 1600 3000 +ldb -1 300 1600 3000 +ldz -1 300 1600 3000 +ldq -1 300 1600 3000 +nb 10 30 60 100 +ldt 10 30 60 100 +K 5 10 20 40 +isgn 1 1 -1 -1 +compq_hgeqz N V N I +compz_hgeqz N V N I +compz N V I N +compz_hseqr N V N I +kb 2 7 1 3 +itype 1 2 3 2 +vect_rd V N U V +side L R L R +eigsrc Q N Q N +initv N U N U +norm M 1 I F +diag N U N U +storev C C R R +tsize -1 -2 -1 -2 +ilo 2 1 500 1500 +ihi 7 100 750 1750 +range_x A A V I +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +abstol -1 -1 -1 -1 +threshold_value 20 20 20 20 diff --git a/test/main/config/short/LIN_SLVR.dat b/test/main/config/short/LIN_SLVR.dat new file mode 100644 index 000000000..010ffbb4b --- /dev/null +++ b/test/main/config/short/LIN_SLVR.dat @@ -0,0 +1,38 @@ +Num_Tests 2 +MRange_start 10 67 100 +MRange_end 20 99 400 +MRange_step_size 10 20 100 +NRange_start 15 89 85 +NRange_end 35 240 385 +NRange_step_size 10 100 100 +lda -1 87 400 +ldb -1 87 400 +ldz -1 87 400 +ldq -1 87 400 +ldab 20 30 400 200 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +trans N T N T +uplo L U U L +compq_gghrd V I V +compz_gghrd V I V +nrhs 1 3 2 4 +ncolm 1 5 10 25 +kl 2 7 1 3 +ku 3 8 2 5 +kd 2 7 5 30 +diag N N N N +fact F E N E +equed N N N N +Symm S H S H +equed_porfsx N N N N +n_err_bnds_porfsx 3 3 3 3 +nparams_porfsx 3 3 3 3 +norm_gbcon 1 O I 1 +kl_gbcon 1 2 3 27 +ku_gbcon 2 3 8 35 +ldab_gbcon 4 7 15 65 +ilo 2 40 1 +ihi 6 55 100 +RSEE_Threshold 10.0 10.0 20.0 50.0 diff --git a/test/main/config/short/SVD.dat b/test/main/config/short/SVD.dat new file mode 100644 index 000000000..262bf3c05 --- /dev/null +++ b/test/main/config/short/SVD.dat @@ -0,0 +1,49 @@ +Num_Tests 2 +MRange_start 10 100 1000 2000 +MRange_end 20 300 1600 3000 +MRange_step_size 10 100 200 1000 +NRange_start 5 120 1400 2500 +NRange_end 100 1000 2000 5000 +NRange_step_size 15 130 250 1600 +lda -1 300 1400 3000 +ldu -1 300 1400 3000 +ldvt -1 1000 2000 5000 +Repeats 1 1 1 1 +DataTypes s d c z +Matrix_Layout 101 102 101 102 +jobu U N U N +jobv V N V N +jobq Q N Q N +m 10 50 100 200 +p 12 40 100 150 +n 15 40 110 130 +tola 1.0 2.0 3.0 +tolb 2.0 2.0 1.0 +jobu_gesvd N A S O +jobvt_gesvd O A S N +joba_gejsv C E F G +jobu_gejsv U F W N +jobv_gejsv V J W N +jobr_gejsv N R N R +jobt_gejsv T N T N +jobp_gejsv P N P N +m_gejsv 15 40 110 200 +n_gejsv 10 30 100 160 +joba_jesvj L U G U +jobu_jesvj U C N U +jobv_jesvj V A N A +m_jesvj 15 40 110 400 +n_jesvj 10 30 100 160 +mv_jesvj 10 25 90 100 +ctol_jesvj 1.5 2.0 2.0 1.0 +jobu_gesvdx N V V V +jobvt_gesvdx V N V V +range_gesvdx A V I A +il 01 10 30 40 +iu 05 20 65 76 +vl 0.1 0.6 0.7 0.0 +vu 0.5 3.0 4.9 0.8 +joba_gesvdq A H M E +jobu_gesvdq A S R N +jobv_gesvdq A V R N +threshold 3.0 5.0 20.0 40.0 diff --git a/test/main/input.global.operations b/test/main/input.global.operations index f8e6ca194..d78e6f0f9 100644 --- a/test/main/input.global.operations +++ b/test/main/input.global.operations @@ -2,6 +2,7 @@ 0 LIN for testing all LIN API's (0 = disable; 1 = enable) 0 EIG for testing all Eigen API's (0 = disable; 1 = enable) 0 SVD for testing all SVD API's (0 = disable; 1 = enable) +0 AUX for testing all auxiliary API's (0 = disable; 1 = enable) # Enable/Disable individual API's 1 ggevx Eigen Values and Vectors (0 = disable; 1 = enable; 2 = enable only this) 1 gesv Linear Solve using LU (0 = disable; 1 = enable; 2 = enable only this) @@ -31,4 +32,8 @@ 1 spffrtx Partial LDLT factorization (0 = disable; 1 = enable; 2 = enable only this) 1 gehrd Hessenberg form by orthogonal transformation (0 = disable; 1 = enable; 2 = enable only this) 1 gghrd Reduces pair of matrices to upper Hessenberg (0 = disable; 1 = enable; 2 = enable only this) -1 hgeqz EigenValue of pairs(H,T) by QZ method (0 = disable; 1 = enable; 2 = enable only this) \ No newline at end of file +1 hgeqz EigenValue of pairs(H,T) by QZ method (0 = disable; 1 = enable; 2 = enable only this) +1 rot ROT applies a plane rotation (0 = disable; 1 = enable; 2 = enable only this) +1 lartg Generates Plane rotation with cos and sin (0 = disable; 1 = enable; 2 = enable only this) +1 org2r QR factorization (0 = disable; 1 = enable; 2 = enable only this) +1 syevx Eigen Values and Vectors (0 = disable; 1 = enable; 2 = enable only this) \ No newline at end of file diff --git a/test/main/main_ctest.cmake b/test/main/main_ctest.cmake new file mode 100644 index 000000000..dbfc1943d --- /dev/null +++ b/test/main/main_ctest.cmake @@ -0,0 +1,84 @@ + +set(CTEST_MAIN_COMMAND ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/${PROJECT_NAME}) +if(WIN32) + set(CTEST_WORKING_DIR ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/${CMAKE_BUILD_TYPE}) +else() + set(CTEST_WORKING_DIR ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) +endif() + +# Added test to run main test suite +foreach(CONFIG_TYPE "long" "medium" "short" "micro") + add_test(NAME main_test_${CONFIG_TYPE} COMMAND ${CTEST_MAIN_COMMAND} --config-dir=${CONFIG_TYPE} WORKING_DIRECTORY ${CTEST_WORKING_DIR}) +endforeach() + +#Example to add further tests to ctest +add_test(NAME custom_main_test_gesv_sdcz_10x10 COMMAND ${CTEST_MAIN_COMMAND} gesv sdzc 10 10 10 10 100) +#Performance tests for DGESVD +add_test(NAME DGESVD_SML_OPT00 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 1 3 3 1 -1 10) +set_property(TEST DGESVD_SML_OPT00 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT01 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 2 3 3 2 -1 10) +set_property(TEST DGESVD_SML_OPT01 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT02 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 3 3 3 3 -1 10) +set_property(TEST DGESVD_SML_OPT02 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT03 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 4 3 3 4 -1 10) +set_property(TEST DGESVD_SML_OPT03 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT04 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 8 3 3 8 -1 10) +set_property(TEST DGESVD_SML_OPT04 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT05 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 9 3 3 9 -1 10) +set_property(TEST DGESVD_SML_OPT05 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT06 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 16 3 3 16 -1 10) +set_property(TEST DGESVD_SML_OPT06 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT07 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 17 3 3 17 -1 10) +set_property(TEST DGESVD_SML_OPT07 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT08 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 21 3 3 21 -1 10) +set_property(TEST DGESVD_SML_OPT08 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT09 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 23 3 3 23 -1 10) +set_property(TEST DGESVD_SML_OPT09 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT10 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 34 3 3 34 -1 10) +set_property(TEST DGESVD_SML_OPT10 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT11 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 40 3 3 40 -1 10) +set_property(TEST DGESVD_SML_OPT11 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT12 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 51 3 3 51 -1 10) +set_property(TEST DGESVD_SML_OPT12 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT13 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 53 3 3 53 -1 10) +set_property(TEST DGESVD_SML_OPT13 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT14 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 67 3 3 67 -1 10) +set_property(TEST DGESVD_SML_OPT14 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT15 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 84 3 3 84 -1 10) +set_property(TEST DGESVD_SML_OPT15 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT16 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 268 3 3 268 -1 10) +set_property(TEST DGESVD_SML_OPT16 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT17 COMMAND ${CTEST_MAIN_COMMAND} gesvd d N N 3 364 3 3 364 -1 10) +set_property(TEST DGESVD_SML_OPT17 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT18 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 1 2 1 1 2 -1 10) +set_property(TEST DGESVD_SML_OPT18 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT19 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 2 3 2 2 3 -1 10) +set_property(TEST DGESVD_SML_OPT19 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT20 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 4 3 4 4 3 -1 10) +set_property(TEST DGESVD_SML_OPT20 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT21 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 4 5 4 4 5 -1 10) +set_property(TEST DGESVD_SML_OPT21 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT22 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 6 3 6 6 3 -1 10) +set_property(TEST DGESVD_SML_OPT22 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") +add_test(NAME DGESVD_SML_OPT23 COMMAND ${CTEST_MAIN_COMMAND} gesvd d S S 6 4 6 6 4 -1 10) +set_property(TEST DGESVD_SML_OPT23 PROPERTY ENVIRONMENT "OMP_NUM_THREADS=64") + +#Performance tests for ZGETRF +foreach(FUNCTION "getrf") + foreach(PREC "z") + foreach(SIZE_N "8" "16" "32" "64" "128" "256" "512" "1024") + add_test(NAME LU_FACTORIZATION_${PREC}${FUNCTION}_${SIZE_N}x${SIZE_N} COMMAND ${CTEST_MAIN_COMMAND} ${FUNCTION} ${PREC} ${SIZE_N} ${SIZE_N} ${SIZE_N} 1) + set_property(TEST LU_FACTORIZATION_${PREC}${FUNCTION}_${SIZE_N}x${SIZE_N} PROPERTY ENVIRONMENT "OMP_NUM_THREADS=1") + endforeach(SIZE_N) + endforeach(PREC) +endforeach(FUNCTION) + +#Example to add loop based tests to ctest +# Note: in forloop based test the variable should also modify the name of the test, since 2 tests cannot have same name +foreach(FUNCTION "gesv") + foreach(PREC "s" "d" "c" "z") + foreach(SIZE_N "10") + add_test(NAME custom_main_test_${PREC}${FUNCTION}_${SIZE_N}x${SIZE_N} COMMAND ${CTEST_MAIN_COMMAND} ${FUNCTION} ${PREC} ${SIZE_N} 10 10 10 10) + endforeach(SIZE_N) + endforeach(PREC) +endforeach(FUNCTION) diff --git a/test/main/negative_test.cmake b/test/main/negative_test.cmake new file mode 100644 index 000000000..edd897db5 --- /dev/null +++ b/test/main/negative_test.cmake @@ -0,0 +1,186 @@ +set(NEGATIVE_TEST_CASES "ggevx sdcz A V V B 10 10 10 10 10 -1 1 --einfo=-1" + "ggevx sdcz B A V B 10 10 10 10 10 -1 1 --einfo=-2" + "ggevx sdcz B V A B 10 10 10 10 10 -1 1 --einfo=-3" + "ggevx sdcz B V V A 10 10 10 10 10 -1 1 --einfo=-4" + "ggevx sdcz B V V B -10 10 10 10 10 -1 1 --einfo=-5" + "ggevx sdcz B V V B 10 -10 10 10 10 -1 1 --einfo=-7" + "ggevx sdcz B V V B 10 10 -10 10 10 -1 1 --einfo=-9" + "ggevx sd B V V B 10 10 10 -10 10 -1 1 --einfo=-14" + "ggevx cz B V V B 10 10 10 -10 10 -1 1 --einfo=-13" + "ggevx sd B V V B 10 10 10 10 -10 -1 1 --einfo=-16" + "ggevx cz B V V B 10 10 10 10 -10 -1 1 --einfo=-15" + "gesv sdcz -10 10 10 10 1 --einfo=-1" + "gesv sdcz 10 -10 10 10 1 --einfo=-2" + "gesv sdcz 10 10 -10 10 1 --einfo=-4" + "gesv sdcz 10 10 10 -10 1 --einfo=-7" + "geqrf sdcz -10 10 10 -1 1 --einfo=-1" + "geqrf sdcz 10 -10 10 -1 1 --einfo=-2" + "geqrf sdcz 10 10 -10 -1 1 --einfo=-4" + "geqrf sdcz 10 10 10 1 1 --einfo=-7" + "gerqf sdcz -10 10 10 -1 1 --einfo=-1" + "gerqf sdcz 10 -10 10 -1 1 --einfo=-2" + "gerqf sdcz 10 10 -10 -1 1 --einfo=-4" + "gerqf sdcz 10 10 10 1 1 --einfo=-7" + "gerq2 sdcz -10 10 10 1 --einfo=-1" + "gerq2 sdcz 10 -10 10 1 --einfo=-2" + "gerq2 sdcz 10 10 -10 1 --einfo=-4" + "gelqf sdcz -10 10 10 -1 1 --einfo=-1" + "gelqf sdcz 10 -10 10 -1 1 --einfo=-2" + "gelqf sdcz 10 10 -10 -1 1 --einfo=-4" + "gelqf sdcz 10 10 10 1 1 --einfo=-7" + "potrf sdcz U -10 10 1 --einfo=-2" + "potrf sdcz X 10 10 1 --einfo=-1" + "potrf sdcz U 10 -10 1 --einfo=-4" + "getrf sdcz -10 10 10 1 --einfo=-1" + "getrf sdcz 10 -10 10 1 --einfo=-2" + "getrf sdcz 10 10 -10 1 --einfo=-4" + "getri sdcz -10 10 -1 1 --einfo=-1" + "getri sdcz 10 -10 -1 1 --einfo=-3" + "getri sdcz 10 10 1 1 --einfo=-6" + "getrs sdcz A 10 10 10 10 1 --einfo=-1" + "getrs sdcz C -10 10 10 10 1 --einfo=-2" + "getrs sdcz C 10 -10 10 10 1 --einfo=-3" + "getrs sdcz C 10 10 -10 10 1 --einfo=-5" + "getrs sdcz C 10 10 10 -10 1 --einfo=-8" + "potrs sdcz A 10 10 10 10 1 --einfo=-1" + "potrs sdcz U -10 10 10 10 1 --einfo=-2" + "potrs sdcz U 10 -10 10 10 1 --einfo=-3" + "potrs sdcz U 10 10 -10 10 1 --einfo=-5" + "potrs sdcz U 10 10 10 -10 1 --einfo=-7" + "orgqr sdcz 10 -10 10 -1 1 --einfo=-2" + "orgqr sdcz 10 10 -10 -1 1 --einfo=-5" + "orgqr sdcz 10 10 10 1 1 --einfo=-8" + "gesdd sdcz A -10 10 10 10 10 -1 1 --einfo=-2" + "gesdd sdcz A 10 -10 10 10 10 -1 1 --einfo=-3" + "gesdd sdcz P 10 10 10 10 10 -1 1 --einfo=-1" + "gesdd sdcz A 10 10 -10 10 10 -1 1 --einfo=-5" + "gesdd sdcz A 10 10 10 -10 10 -1 1 --einfo=-8" + "gesdd sdcz A 10 10 10 10 -10 -1 1 --einfo=-10" + "gesdd sdcz A 10 10 10 10 10 1 1 --einfo=-12" + "syevd sdcz V U -10 10 -1 -1 -1 1 --einfo=-3" + "syevd sdcz A U 10 10 -1 -1 -1 1 --einfo=-1" + "syevd sdcz V A 10 10 -1 -1 -1 1 --einfo=-2" + "syevd sdcz V U 10 -10 -1 -1 -1 1 --einfo=-5" + "syevd sd V U 10 10 1 1 -1 1 --einfo=-8" + "syevd sd V U 10 10 1000 1 -1 1 --einfo=-10" + "syevd cz V U 10 10 1 1 1 1 --einfo=-8" + "syevd cz V U 10 10 1000 1 1 1 --einfo=-10" + "syevd cz V U 10 10 1000 1 1000 1 --einfo=-12" + "gesvd sdcz X A 10 10 10 10 10 -1 1 --einfo=-1" + "gesvd sdcz A X 10 10 10 10 10 -1 1 --einfo=-2" + "gesvd sdcz A A -10 10 10 10 10 -1 1 --einfo=-3" + "gesvd sdcz A A 10 -10 10 10 10 -1 1 --einfo=-4" + "gesvd sdcz A A 10 10 -10 10 10 -1 1 --einfo=-6" + "gesvd sdcz A A 10 10 10 -10 10 -1 1 --einfo=-9" + "gesvd sdcz A A 10 10 10 10 -10 -1 1 --einfo=-11" + "gesvd sdcz A A 10 10 10 10 10 1 1 --einfo=-13" + "geevx sdcz A V V B 10 10 10 10 -1 1 --einfo=-1" + "geevx sdcz B A V V 10 10 10 10 -1 1 --einfo=-2" + "geevx sdcz B V A V 10 10 10 10 -1 1 --einfo=-3" + "geevx sdcz B V V A 10 10 10 10 -1 1 --einfo=-4" + "geevx sdcz B V V B -10 10 10 10 -1 1 --einfo=-5" + "geevx sdcz B V V B 10 -10 10 10 -1 1 --einfo=-7" + "geevx sd B V V B 10 10 -10 10 -1 1 --einfo=-11" + "geevx cz B V V B 10 10 -10 10 -1 1 --einfo=-10" + "geevx sd B V V B 10 10 10 -10 -1 1 --einfo=-13" + "geevx cz B V V B 10 10 10 -10 -1 1 --einfo=-12" + "geevx sd B V V B 10 10 10 10 1 1 --einfo=-21" + "geevx cz B V V B 10 10 10 10 1 1 --einfo=-20" + "geev sdcz A V 10 10 10 10 -1 1 --einfo=-1" + "geev sdcz V A 10 10 10 10 -1 1 --einfo=-2" + "geev sdcz V V -10 10 10 10 -1 1 --einfo=-3" + "geev sdcz V V 10 -10 10 10 -1 1 --einfo=-5" + "geev sd V V 10 10 -10 10 -1 1 --einfo=-9" + "geev cz V V 10 10 -10 10 -1 1 --einfo=-8" + "geev sd V V 10 10 10 -10 -1 1 --einfo=-11" + "geev cz V V 10 10 10 -10 -1 1 --einfo=-10" + "geev sd V V 10 10 10 10 1 1 --einfo=-13" + "geev cz V V 10 10 10 10 1 1 --einfo=-12" + "geqp3 sdcz -10 10 10 -1 1 --einfo=-1" + "geqp3 sdcz 10 -10 10 -1 1 --einfo=-2" + "geqp3 sdcz 10 10 -10 -1 1 --einfo=-4" + "geqp3 sdcz 10 10 10 1 1 --einfo=-8" + "ggev sdcz V V -10 10 10 10 10 -1 1 --einfo=-3" + "ggev sdcz V V 10 -10 10 10 10 -1 1 --einfo=-5" + "ggev sd V V 10 10 10 -10 10 -1 1 --einfo=-12" + "ggev cz V V 10 10 10 -10 10 -1 1 --einfo=-11" + "ggev sd V V 10 10 10 10 -10 -1 1 --einfo=-14" + "ggev cz V V 10 10 10 10 -10 -1 1 --einfo=-13" + "ggev sd V V 10 10 10 10 10 1 1 --einfo=-16" + "ggev cz V V 10 10 10 10 10 1 1 --einfo=-15" + "steqr sdcz A 10 10 1 --einfo=-1" + "steqr sdcz V -10 10 1 --einfo=-2" + "steqr sdcz V 10 -10 1 --einfo=-6" + "stevd sd A 10 10 -1 -1 1 --einfo=-1" + "stevd sd V -10 10 -1 -1 1 --einfo=-2" + "stevd sd V 10 -10 -1 -1 1 --einfo=-6" + "stevd sd V 10 10 1 1 1 --einfo=-8" + "stevd sd V 10 10 1000 1 1 --einfo=-10" + "stedc sdcz A 10 10 -1 -1 -1 1 --einfo=-1" + "stedc sdcz V -10 10 -1 -1 -1 1 --einfo=-2" + "stedc sdcz V 10 -10 -1 -1 -1 1 --einfo=-6" + "stedc sd V 10 10 1 1 -1 1 --einfo=-8" + "stedc cz V 10 10 1000 1 1 1 --einfo=-10" + "hseqr sdcz V V 10 2 5 10 10 -1 1 --einfo=-1" + "hseqr sdcz S S 10 2 5 10 10 -1 1 --einfo=-2" + "hseqr sdcz S V -10 2 5 10 10 -1 1 --einfo=-3" + "hseqr sdcz S V 10 11 5 10 10 -1 1 --einfo=-4" + "hseqr sdcz S V 10 2 12 10 10 -1 1 --einfo=-5" + "hseqr sdcz S V 10 2 5 -10 10 -1 1 --einfo=-7" + "hseqr sd S V 10 2 5 10 -10 -1 1 --einfo=-11" + "hseqr cz S V 10 2 5 10 -10 -1 1 --einfo=-10" + "hseqr sd S V 10 2 5 10 10 1 1 --einfo=-13" + "hseqr cz S V 10 2 5 10 10 1 1 --einfo=-12" + "syev sdcz A U 10 10 -1 1 --einfo=-1" + "syev sdcz V A 10 10 -1 1 --einfo=-2" + "syev sdcz V U -10 10 -1 1 --einfo=-3" + "syev sdcz V U 10 -10 -1 1 --einfo=-5" + "syev sdcz V U 10 10 1 1 --einfo=-8" + "gehrd sdcz -10 2 5 10 -1 1 --einfo=-1" + "gehrd sdcz 10 11 5 10 -1 1 --einfo=-2" + "gehrd sdcz 10 2 12 10 -1 1 --einfo=-3" + "gehrd sdcz 10 2 5 -10 -1 1 --einfo=-5" + "gehrd sdcz 10 2 5 10 1 1 --einfo=-8" + "gghrd sdcz A V 10 2 5 10 10 10 10 1 --einfo=-1" + "gghrd sdcz V A 10 2 5 10 10 10 10 1 --einfo=-2" + "gghrd sdcz V V -10 2 5 10 10 10 10 1 --einfo=-3" + "gghrd sdcz V V 10 0 5 10 10 10 10 1 --einfo=-4" + "gghrd sdcz V V 10 2 11 10 10 10 10 1 --einfo=-5" + "gghrd sdcz V V 10 2 5 -10 10 10 10 1 --einfo=-7" + "gghrd sdcz V V 10 2 5 10 -10 10 10 1 --einfo=-9" + "gghrd sdcz V V 10 2 5 10 10 10 -10 1 --einfo=-13" + "hgeqz sdcz A V V 10 2 4 10 10 10 10 -1 1 --einfo=-1" + "hgeqz sdcz S A V 10 2 4 10 10 10 10 -1 1 --einfo=-2" + "hgeqz sdcz S V V -10 2 4 10 10 10 10 -1 1 --einfo=-4" + "hgeqz sdcz S V V 10 0 4 10 10 10 10 -1 1 --einfo=-5" + "hgeqz sdcz S V V 10 2 12 10 10 10 10 -1 1 --einfo=-6" + "hgeqz sdcz S V V 10 2 4 -10 10 10 10 -1 1 --einfo=-8" + "hgeqz sdcz S V V 10 2 4 10 -10 10 10 -1 1 --einfo=-10" + "hgeqz sd S V V 10 2 4 10 10 -10 10 -1 1 --einfo=-15" + "hgeqz cz S V V 10 2 4 10 10 -10 10 -1 1 --einfo=-14" + "hgeqz sd S V V 10 2 4 10 10 10 -10 -1 1 --einfo=-17" + "hgeqz cz S V V 10 2 4 10 10 10 -10 -1 1 --einfo=-16" + "hgeqz sd S V V 10 2 4 10 10 10 10 1 1 --einfo=-19" + "hgeqz cz S V V 10 2 4 10 10 10 10 1 1 --einfo=-18" + "org2r sdcz 10 -10 10 1 --einfo=-2" + "org2r sdcz 10 10 -10 1 --einfo=-5" + "syevx sdcz B A U 10 12 1.0 20.0 1 3 -1 12 -1 1 --einfo=-1" + "syevx sdcz V B U 10 12 1.0 20.0 1 3 -1 12 -1 1 --einfo=-2" + "syevx sdcz V A X 10 12 1.0 20.0 1 3 -1 12 -1 1 --einfo=-3" + "syevx sdcz V A U -1 12 1.0 20.0 1 3 -1 12 -1 1 --einfo=-4" + "syevx sdcz V A U 10 5 1.0 20.0 1 3 -1 12 -1 1 --einfo=-6" + "syevx sdcz V V U 10 15 10 -1 1 3 -1 15 -1 1 --einfo=-8" + "syevx sdcz V I U 10 15 10 20 -1 1 -1 15 -1 1 --einfo=-9" + "syevx sdcz V I U 10 15 10 20 1 -1 -1 15 -1 1 --einfo=-10" + "syevx sdcz V A U 10 15 100.0 20.0 1 3 -1 5 -1 1 --einfo=-15" + "syevx sdcz V A U 10 15 100.0 20.0 1 3 -1 12 10 1 --einfo=-17") + +set(TEST_NUM 1) +foreach(neg_test_cases IN LISTS NEGATIVE_TEST_CASES) + # this line splits entire string into separate arguments as ctest requres the arguments to be passed separately rather than a single string + string(REPLACE " " ";" COMMANDLINE_PARAMS ${neg_test_cases}) + set(TEST_NAME NEGATIVE_TEST_CASE_${TEST_NUM} ) + add_test(${TEST_NAME} ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/${PROJECT_NAME} ${COMMANDLINE_PARAMS}) + set_tests_properties(${TEST_NAME} PROPERTIES FAIL_REGULAR_EXPRESSION "FAIL;No test was run, give valid arguments") +MATH(EXPR TEST_NUM "${TEST_NUM}+1") +endforeach() diff --git a/test/main/src/CMakeLists.txt b/test/main/src/CMakeLists.txt index a10621ec2..b97ad9663 100644 --- a/test/main/src/CMakeLists.txt +++ b/test/main/src/CMakeLists.txt @@ -34,6 +34,10 @@ ${CMAKE_CURRENT_SOURCE_DIR}/test_spffrtx.c ${CMAKE_CURRENT_SOURCE_DIR}/test_gehrd.c ${CMAKE_CURRENT_SOURCE_DIR}/test_hgeqz.c ${CMAKE_CURRENT_SOURCE_DIR}/test_gghrd.c +${CMAKE_CURRENT_SOURCE_DIR}/test_rot.c +${CMAKE_CURRENT_SOURCE_DIR}/test_lartg.c +${CMAKE_CURRENT_SOURCE_DIR}/test_org2r.c +${CMAKE_CURRENT_SOURCE_DIR}/test_syevx.c ${CMAKE_CURRENT_SOURCE_DIR}/test_lapack.c ${CMAKE_CURRENT_SOURCE_DIR}/test_lapack.h ${CMAKE_CURRENT_SOURCE_DIR}/test_routines.h diff --git a/test/main/src/test_geev.c b/test/main/src/test_geev.c index 63fd0f189..80afc286a 100644 --- a/test/main/src/test_geev.c +++ b/test/main/src/test_geev.c @@ -9,26 +9,20 @@ /* Local prototypes.*/ void fla_test_geev_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_geev_run(char *jobvl, char *jobvr, integer n, void *a, integer lda, void *wr, void *wi, void *w, void *vl, integer ldvl, void *vr, integer ldvr, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_geev(integer datatype, char *jobvl, char *jobvr, integer *n, void *a, integer *lda, void *wr, void *wi, void *w, void *vl, integer *ldvl, void *vr, integer *ldvr, void* work, integer* lwork, void* rwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_geev(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Decomposition of non symmetric matrix"; char* front_str = "GEEV"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_NSYM, fla_test_geev_experiment); @@ -36,13 +30,7 @@ void fla_test_geev(integer argc, char ** argv, test_params_t *params) } if(argc == 12) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[11], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[11]); } if(argc >= 11 && argc <= 12) { @@ -89,7 +77,7 @@ void fla_test_geev(integer argc, char ** argv, test_params_t *params) fla_test_geev_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -116,6 +104,7 @@ void fla_test_geev(integer argc, char ** argv, test_params_t *params) if(g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -127,6 +116,7 @@ void fla_test_geev_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -143,16 +133,44 @@ void fla_test_geev_experiment(test_params_t *params, ldvl = params->eig_non_sym_paramslist[pci].ldvl; ldvr = params->eig_non_sym_paramslist[pci].ldvr; - if(lda < n || ldvl < n || ldvr < n) - { - *residual = DBL_MIN; - return; - } - *residual = params->eig_non_sym_paramslist[pci].GenNonSymEigProblem_threshold; jobvl = params->eig_non_sym_paramslist[pci].jobvsl; jobvr = params->eig_non_sym_paramslist[pci].jobvsr; + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (lda == -1) + { + lda = fla_max(1,n); + } + /* LDVL >= 1; if JOBVL = 'V', LDVL >= N */ + if (ldvl == -1) + { + if (jobvl == 'V') + { + ldvl = n; + } + else + { + ldvl = 1; + } + } + /* LDVR >= 1; if JOBVR = 'V', LDVR >= N */ + if (ldvr == -1) + { + if (jobvr == 'V') + { + ldvr = n; + } + else + { + ldvr = 1; + } + } + } + /* Create input matrix parameters */ create_matrix(datatype, &A, lda, n); create_matrix(datatype, &VL, ldvl, n); @@ -167,16 +185,7 @@ void fla_test_geev_experiment(test_params_t *params, create_vector(datatype, &wi, n); } - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, n, n, lda); - } + init_matrix(datatype, A, n, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality. */ create_matrix(datatype, &A_test, lda, n); @@ -199,9 +208,7 @@ void fla_test_geev_experiment(test_params_t *params, if (info == 0) validate_geev(&jobvl, &jobvr, n, A, A_test, lda, VL, ldvl, VR, ldvr, w, wr, wi, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -254,16 +261,12 @@ void prepare_geev_run(char *jobvl, char *jobvr, integer m_A, void *A, integer ld /* call to geev API */ invoke_geev(datatype, jobvl, jobvr, &m_A, NULL, &lda, NULL, NULL, NULL, NULL, &ldvl, NULL, &ldvr, work, &lwork, rwork, info); - if (*info < 0) + if (*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work ); } - /* Get work size */ - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -277,6 +280,7 @@ void prepare_geev_run(char *jobvl, char *jobvr, integer m_A, void *A, integer ld free_vector(rwork); } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_geevx.c b/test/main/src/test_geevx.c index 71a8e8d29..3992a3d81 100644 --- a/test/main/src/test_geevx.c +++ b/test/main/src/test_geevx.c @@ -9,7 +9,7 @@ /* Local prototypes.*/ void fla_test_geevx_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_geevx_run(char *balanc, char *jobvl, char *jobvr, char * sense, integer n, void *a, integer lda, void *wr, void *wi, void *w, void *vl, integer ldvl, void *vr, integer ldvr, integer *ilo, integer * ihi, void *scale, void *abnrm, void *rconde, void *rcondv, integer datatype, integer n_repeats, double* time_min_, integer* info); @@ -18,22 +18,16 @@ void invoke_geevx(integer datatype, char *balanc, char *jobvl, char *jobvr, char void *scale, void *abnrm, void *rconde, void *rcondv, void* work, integer* lwork, void* rwork, integer* iwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_geevx(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Decomposition of non symmetric matrix"; char* front_str = "GEEVX"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_NSYM, fla_test_geevx_experiment); @@ -41,13 +35,7 @@ void fla_test_geevx(integer argc, char ** argv, test_params_t *params) } if (argc == 14) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[13], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[13]); } if (argc >= 13 && argc <= 14) { @@ -96,7 +84,7 @@ void fla_test_geevx(integer argc, char ** argv, test_params_t *params) fla_test_geevx_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -123,6 +111,7 @@ void fla_test_geevx(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -133,6 +122,7 @@ void fla_test_geevx_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -151,12 +141,6 @@ void fla_test_geevx_experiment(test_params_t *params, ldvl = params->eig_non_sym_paramslist[pci].ldvl; ldvr = params->eig_non_sym_paramslist[pci].ldvr; - if(lda < m || ldvl < m || ldvr < m) - { - *residual = DBL_MIN; - return; - } - *residual = params->eig_non_sym_paramslist[pci].GenNonSymEigProblem_threshold; balanc = params->eig_non_sym_paramslist[pci].balance_ggevx; jobvl = params->eig_non_sym_paramslist[pci].jobvsl; @@ -167,6 +151,40 @@ void fla_test_geevx_experiment(test_params_t *params, jobvl = 'V'; jobvr = 'V'; } + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (lda == -1) + { + lda = fla_max(1,m); + } + /* LDVL >= 1; if JOBVL = 'V', LDVL >= M */ + if (ldvl == -1) + { + if (jobvl == 'V') + { + ldvl = m; + } + else + { + ldvl = 1; + } + } + /* LDVR >= 1; if JOBVR = 'V', LDVR >= M */ + if (ldvr == -1) + { + if (jobvr == 'V') + { + ldvr = m; + } + else + { + ldvr = 1; + } + } + } + /* Create input matrix parameters */ create_matrix(datatype, &A, lda, m); @@ -187,16 +205,7 @@ void fla_test_geevx_experiment(test_params_t *params, create_vector(datatype, &wi, m); } - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, m, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, m, lda); - } + init_matrix(datatype, A, m, m, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality. */ create_matrix(datatype, &A_test, lda, m); @@ -220,9 +229,7 @@ void fla_test_geevx_experiment(test_params_t *params, validate_geevx(&jobvl, &jobvr, &sense, &balanc, m, A, A_test, lda, VL, ldvl, VR, ldvr, w, wr, wi, scale, abnrm, rconde, rcondv, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -282,16 +289,12 @@ void prepare_geevx_run(char *balanc, char *jobvl, char *jobvr, char * sense, invoke_geevx(datatype, balanc, jobvl, jobvr, sense, &m_A, NULL, &lda, NULL, NULL, NULL, NULL, &ldvl, NULL, &ldvr, ilo, ihi, NULL, NULL, NULL, NULL, work, &lwork, rwork, NULL, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work ); } - /* Get work size */ - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -306,6 +309,7 @@ void prepare_geevx_run(char *balanc, char *jobvl, char *jobvr, char * sense, free_vector(rwork); } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_gehrd.c b/test/main/src/test_gehrd.c index b7de9941c..ad9e6e585 100644 --- a/test/main/src/test_gehrd.c +++ b/test/main/src/test_gehrd.c @@ -8,25 +8,20 @@ /* Local prototypes */ void fla_test_gehrd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gehrd_run(integer n, integer* ilo, integer* ihi, void* A, integer lda, void *tau, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_gehrd(integer datatype, integer* n, integer* ilo, integer* ihi, void* a, integer* lda, void *tau, void* work, integer* lwork, integer* info); -static FILE* g_ext_fptr = NULL; -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; void fla_test_gehrd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Reduces matrix to upper hessenberg from"; char* front_str = "GEHRD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_gehrd_experiment); @@ -34,13 +29,7 @@ void fla_test_gehrd(integer argc, char ** argv, test_params_t *params) } if(argc == 10) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[9], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[9]); } if(argc >=9 && argc <= 10) { @@ -84,7 +73,7 @@ void fla_test_gehrd(integer argc, char ** argv, test_params_t *params) fla_test_gehrd_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -111,6 +100,7 @@ void fla_test_gehrd(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } } @@ -120,6 +110,7 @@ void fla_test_gehrd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *time_min, double *residual) @@ -132,10 +123,14 @@ void fla_test_gehrd_experiment(test_params_t *params, n = p_cur; lda = params->lin_solver_paramslist[pci].lda; - if(lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } } /* Initialize parameter needed for gehrd() call. */ @@ -175,8 +170,8 @@ void fla_test_gehrd_experiment(test_params_t *params, /* Output Validation */ if(info == 0) validate_gehrd(n, ilo, ihi, A, A_Test, lda, tau, datatype, residual, &vinfo); - else - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -211,20 +206,16 @@ void prepare_gehrd_run(integer n, integer* ilo, integer* ihi, void* A, integer l { /* Get work size */ lwork = get_work_value( datatype, work ); - free_vector(work); - } - else - { - free_vector(work); - free_matrix(A_save); - return; } + + free_vector(work); } else { lwork = g_lwork; } + *info = 0; for(i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix H and Z value and allocate memory to output buffers @@ -246,11 +237,11 @@ void prepare_gehrd_run(integer n, integer* ilo, integer* ihi, void* A, integer l /* Free up the output buffers */ free_vector(work); + free_vector(tau_test); } *time_min_ = time_min; free_matrix(A_save); - free_vector(tau_test); } void invoke_gehrd(integer datatype, integer* n, integer* ilo, integer* ihi, void* A, integer* lda, void *tau, void* work, integer* lwork, integer* info) diff --git a/test/main/src/test_gelqf.c b/test/main/src/test_gelqf.c index f78c3f020..05901463b 100644 --- a/test/main/src/test_gelqf.c +++ b/test/main/src/test_gelqf.c @@ -6,26 +6,20 @@ // Local prototypes. void fla_test_gelqf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, - double* perf, double* t,double* residual); + integer einfo, double* perf, double* t,double* residual); void prepare_gelqf_run(integer m_A, integer n_A, void *A, integer lda, void *T, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_gelqf(integer datatype, integer* m, integer* n, void* a, integer* lda, void* tau, void* work, integer* lwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_gelqf(integer argc, char ** argv, test_params_t *params) { char* op_str = "LQ factorization"; char* front_str = "GEQLF"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_gelqf_experiment); @@ -33,13 +27,7 @@ void fla_test_gelqf(integer argc, char ** argv, test_params_t *params) } if(argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[8], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } if(argc >= 8 && argc <= 9) { @@ -83,7 +71,7 @@ void fla_test_gelqf(integer argc, char ** argv, test_params_t *params) fla_test_gelqf_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -110,6 +98,7 @@ void fla_test_gelqf(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -121,6 +110,7 @@ void fla_test_gelqf_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -134,27 +124,23 @@ void fla_test_gelqf_experiment(test_params_t *params, m = p_cur; n = q_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } /* Create input matrix parameters */ create_matrix(datatype, &A, lda, n); create_vector(datatype, &T, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality. */ create_matrix(datatype, &A_test, lda, n); @@ -179,9 +165,7 @@ void fla_test_gelqf_experiment(test_params_t *params, if (info == 0) validate_gelqf(m, n, A, A_test, lda, T, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -220,16 +204,12 @@ void prepare_gelqf_run(integer m_A, integer n_A, /* call to gelqf API */ invoke_gelqf(datatype, &m_A, &n_A, NULL, &lda, NULL, work, &lwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work ); } - /* Get work size */ - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -239,6 +219,7 @@ void prepare_gelqf_run(integer m_A, integer n_A, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_geqp3.c b/test/main/src/test_geqp3.c index 3a72b3093..eab9225ee 100644 --- a/test/main/src/test_geqp3.c +++ b/test/main/src/test_geqp3.c @@ -6,28 +6,22 @@ /* Local prototypes */ void fla_test_geqp3_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, - integer pci, integer n_repeats, double* perf, double* t,double* residual); + integer pci, integer n_repeats, integer einfo, double* perf, double* t,double* residual); void prepare_geqp3_run(integer m_A, integer n_A, void *A, integer lda, integer *jpvt, void *T, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_geqp3(integer datatype, integer* m, integer* n, void* a, integer* lda, integer *jpvt, void* tau, void* work, integer* lwork, void* rwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_geqp3(integer argc, char ** argv, test_params_t *params) { char* op_str = "QR factorization with column pivoting"; char* front_str = "GEQP3"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_geqp3_experiment); @@ -35,13 +29,7 @@ void fla_test_geqp3(integer argc, char ** argv, test_params_t *params) } if(argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[8], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } if(argc >= 8 && argc <= 9) { @@ -85,7 +73,7 @@ void fla_test_geqp3(integer argc, char ** argv, test_params_t *params) fla_test_geqp3_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -112,6 +100,7 @@ void fla_test_geqp3(integer argc, char ** argv, test_params_t *params) if(g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -123,6 +112,7 @@ void fla_test_geqp3_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -139,27 +129,21 @@ void fla_test_geqp3_experiment(test_params_t *params, n = q_cur; lda = params->lin_solver_paramslist[pci].lda; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } /* Create input matrix parameters */ create_matrix(datatype, &A, lda, n); create_vector(datatype, &T, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix A with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } - + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A,required for validation. */ create_matrix(datatype, &A_test, lda, n); @@ -186,11 +170,8 @@ void fla_test_geqp3_experiment(test_params_t *params, /* output validation */ if (info == 0) validate_geqp3(m, n, A, A_test, lda, jpvt, T, datatype, residual, &vinfo); - - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -232,16 +213,12 @@ void prepare_geqp3_run(integer m_A, integer n_A, /* call to geqp3 API */ invoke_geqp3(datatype, &m_A, &n_A, NULL, &lda, NULL, NULL, work, &lwork, rwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work ); } - /* Get work size */ - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers. */ free_vector(work); @@ -255,6 +232,7 @@ void prepare_geqp3_run(integer m_A, integer n_A, if (datatype >= COMPLEX) create_realtype_vector(datatype, &rwork, 2 * n_A); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_geqrf.c b/test/main/src/test_geqrf.c index 46dba3707..d8ece8fd2 100644 --- a/test/main/src/test_geqrf.c +++ b/test/main/src/test_geqrf.c @@ -6,25 +6,19 @@ // Local prototypes. void fla_test_geqrf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, - double* perf, double* t,double* residual); + integer einfo, double* perf, double* t,double* residual); void prepare_geqrf_run(integer m_A, integer n_A, void *A, integer lda, void *T, integer datatype, integer n_repeats, double* time_min_, integer *info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_geqrf(integer argc, char ** argv, test_params_t *params) { char* op_str = "RQ factorization"; char* front_str = "GEQRF"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_geqrf_experiment); @@ -32,13 +26,7 @@ void fla_test_geqrf(integer argc, char ** argv, test_params_t *params) } if(argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[8], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } if(argc >= 8 && argc <= 9) { @@ -82,7 +70,7 @@ void fla_test_geqrf(integer argc, char ** argv, test_params_t *params) fla_test_geqrf_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -109,6 +97,7 @@ void fla_test_geqrf(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -120,6 +109,7 @@ void fla_test_geqrf_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -133,27 +123,23 @@ void fla_test_geqrf_experiment(test_params_t *params, m = p_cur; n = q_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } // Create input matrix parameters create_matrix(datatype, &A, lda, n); create_vector(datatype, &T, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); // Make a copy of input matrix A. This is required to validate the API functionality. create_matrix(datatype, &A_test, lda, n); @@ -177,10 +163,8 @@ void fla_test_geqrf_experiment(test_params_t *params, if (info == 0) validate_geqrf(m, n, A, A_test, lda, T, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; - + FLA_TEST_CHECK_EINFO(residual, info, einfo); + // Free up the buffers free_matrix(A); free_matrix(A_test); @@ -218,16 +202,11 @@ void prepare_geqrf_run(integer m_A, integer n_A, // call to geqrf API invoke_geqrf(datatype, &m_A, &n_A, NULL, &lda, NULL, work, &lwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + lwork = get_work_value( datatype, work ); } - // Get work size - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -237,6 +216,7 @@ void prepare_geqrf_run(integer m_A, integer n_A, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_gerq2.c b/test/main/src/test_gerq2.c index 81cd74309..316d470fc 100644 --- a/test/main/src/test_gerq2.c +++ b/test/main/src/test_gerq2.c @@ -6,18 +6,18 @@ // Local prototypes. void fla_test_gerq2_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gerq2_run(integer m_A, integer n_A, void *A, integer lda, void *T, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_gerq2(integer datatype, integer *m, integer *n, void *a, integer *lda, void *tau, void *work, integer *info); -static FILE* g_ext_fptr = NULL; void fla_test_gerq2(integer argc, char ** argv, test_params_t *params) { char* op_str = "RQ factorization with unblocked algorithm"; char* front_str = "GERQ2"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_gerq2_experiment); @@ -25,13 +25,7 @@ void fla_test_gerq2(integer argc, char ** argv, test_params_t *params) } if (argc == 8) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[7]); } if (argc >= 7 && argc <= 8) { @@ -74,7 +68,7 @@ void fla_test_gerq2(integer argc, char ** argv, test_params_t *params) fla_test_gerq2_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -101,6 +95,7 @@ void fla_test_gerq2(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -113,6 +108,7 @@ void fla_test_gerq2_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -126,27 +122,23 @@ void fla_test_gerq2_experiment(test_params_t *params, m = p_cur; n = q_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } // Create input matrix parameters create_matrix(datatype, &A, lda, n); create_vector(datatype, &T, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); // Make a copy of input matrix A. This is required to validate the API functionality. create_matrix(datatype, &A_test, lda, n); @@ -170,9 +162,7 @@ void fla_test_gerq2_experiment(test_params_t *params, if(info == 0) validate_gerq2(m, n, A, A_test, lda, T, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); // Free up buffers free_matrix(A); @@ -201,6 +191,7 @@ void prepare_gerq2_run(integer m_A, integer n_A, create_matrix(datatype, &A_save, lda, n_A); copy_matrix(datatype, "full", m_A, n_A, A, lda, A_save, lda); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_gerqf.c b/test/main/src/test_gerqf.c index 4e44681d8..aeec9c2e0 100644 --- a/test/main/src/test_gerqf.c +++ b/test/main/src/test_gerqf.c @@ -6,25 +6,19 @@ // Local prototypes. void fla_test_gerqf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gerqf_run(integer m_A, integer n_A, void *A, integer lda, void *T, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_gerqf(integer datatype, integer *m, integer *n, void *a, integer *lda, void *tau, void *work, integer *lwork, integer *info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_gerqf(integer argc, char ** argv, test_params_t *params) { char* op_str = "RQ factorization"; char* front_str = "GERQF"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_gerqf_experiment); @@ -32,13 +26,7 @@ void fla_test_gerqf(integer argc, char ** argv, test_params_t *params) } if (argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[8], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } if (argc >= 8 && argc <= 9) { @@ -82,7 +70,7 @@ void fla_test_gerqf(integer argc, char ** argv, test_params_t *params) fla_test_gerqf_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -99,7 +87,7 @@ void fla_test_gerqf(integer argc, char ** argv, test_params_t *params) /* Print error messages */ if(tests_not_run) { - printf("\nIllegal arguments for geqrf\n"); + printf("\nIllegal arguments for gerqf\n"); printf("./ gerqf \n"); } if(invalid_dtype) @@ -109,8 +97,10 @@ void fla_test_gerqf(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } + return; } @@ -121,6 +111,7 @@ void fla_test_gerqf_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -134,27 +125,23 @@ void fla_test_gerqf_experiment(test_params_t *params, m = p_cur; n = q_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } // Create input matrix parameters create_matrix(datatype, &A, lda, n); create_vector(datatype, &T, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); // Make a copy of input matrix A. This is required to validate the API functionality. create_matrix(datatype, &A_test, lda, n); @@ -178,9 +165,7 @@ void fla_test_gerqf_experiment(test_params_t *params, if (info == 0 ) validate_gerqf(m, n, A, A_test, lda, T, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); // Free up the buffers free_matrix(A); @@ -220,16 +205,12 @@ void prepare_gerqf_run(integer m_A, // call to gerqf API invoke_gerqf(datatype, &m_A, &n_A, NULL, &lda, NULL, work, &lwork, info); - if(*info < 0) + if(*info == 0) { - free_vector(work); - free_matrix(A_save); - return; + // Get work size + lwork = get_work_value( datatype, work ); } - // Get work size - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -239,6 +220,7 @@ void prepare_gerqf_run(integer m_A, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_gesdd.c b/test/main/src/test_gesdd.c index e52f27565..8f6423190 100644 --- a/test/main/src/test_gesdd.c +++ b/test/main/src/test_gesdd.c @@ -9,26 +9,20 @@ /* Local prototypes.*/ void fla_test_gesdd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, -integer n_repeats, double* perf, double* t, double* residual); +integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gesdd_run(char *jobz, integer m_A, integer n_A, void *A, integer lda, void *s, void *U, integer ldu, void *V, integer ldvt, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_gesdd(integer datatype, char* jobz, integer* m, integer* n, void* a, integer* lda, void* s, void* u, integer* ldu, void* vt, integer* ldvt, void* work, integer* lwork, void* rwork, integer* iwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_gesdd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Singular value decomposition"; char* front_str = "GESDD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, SVD, fla_test_gesdd_experiment); @@ -36,13 +30,7 @@ void fla_test_gesdd(integer argc, char ** argv, test_params_t *params) } if (argc == 12) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[11], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[11]); } if (argc >= 11 && argc <= 12) { @@ -90,7 +78,7 @@ void fla_test_gesdd(integer argc, char ** argv, test_params_t *params) fla_test_gesdd_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -117,6 +105,7 @@ void fla_test_gesdd(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -127,6 +116,7 @@ void fla_test_gesdd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -155,10 +145,45 @@ void fla_test_gesdd_experiment(test_params_t *params, ldu = params->svd_paramslist[pci].ldu; ldvt = params->svd_paramslist[pci].ldvt; - if(lda < m || ldu < m || ldvt < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } + /* LDU >= 1; + if JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. */ + if (ldu == -1) + { + if (((jobz == 'S') || (jobz == 'A')) || ((jobz == 'O') && (m < n))) + { + ldu = m; + } + else + { + ldu = 1; + } + } + /* LDVT >= 1; + if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; + if JOBZ = 'S', LDVT >= min(M,N). */ + if (ldvt == -1) + { + if ((jobz == 'A') || ((jobz == 'O') && (m >= n))) + { + ldvt = n; + } + else if (jobz == 'S') + { + ldvt = fla_min(m,n); + } + else + { + ldvt = 1; + } + } } /* Create input matrix parameters */ @@ -167,16 +192,7 @@ void fla_test_gesdd_experiment(test_params_t *params, create_matrix(datatype, &V, ldvt, n); create_realtype_vector(datatype, &s, fla_min(m, n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality.*/ create_matrix(datatype, &A_test, lda, n); @@ -197,9 +213,7 @@ void fla_test_gesdd_experiment(test_params_t *params, if((jobz == 'A' || jobz == 'S' || jobz == 'O') && info == 0) validate_gesdd(&jobz, m, n, A, A_test, lda, s, U, ldu, V, ldvt, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -252,16 +266,12 @@ void prepare_gesdd_run(char *jobz, /* call to gesdd API */ invoke_gesdd(datatype, jobz, &m_A, &n_A, NULL, &lda, NULL, NULL, &ldu, NULL, &ldvt, work, &lwork, NULL, NULL, info); - if (*info < 0) + if (*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work ); } - /* Get work size */ - lwork = get_work_value( datatype, work ); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -271,6 +281,7 @@ void prepare_gesdd_run(char *jobz, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_gesv.c b/test/main/src/test_gesv.c index 69849e48c..aa04e6438 100644 --- a/test/main/src/test_gesv.c +++ b/test/main/src/test_gesv.c @@ -6,19 +6,19 @@ /* Local prototypes */ void fla_test_gesv_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gesv_run(integer n_A, integer nrhs, void *A, integer lda, void *B, integer ldb, integer* ipiv, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_gesv(integer datatype, integer *nrhs, integer *n, void *a, integer *lda, integer *ipiv, void *b, integer *ldb, integer *info); -static FILE* g_ext_fptr = NULL; void fla_test_gesv(integer argc, char ** argv, test_params_t *params) { char* op_str = "Linear Solve using LU"; char* front_str = "GESV"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_gesv_experiment); @@ -26,13 +26,7 @@ void fla_test_gesv(integer argc, char ** argv, test_params_t *params) } if (argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[8], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } if (argc >= 8 && argc <= 9) { @@ -77,7 +71,7 @@ void fla_test_gesv(integer argc, char ** argv, test_params_t *params) fla_test_gesv_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -104,6 +98,7 @@ void fla_test_gesv(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -116,6 +111,7 @@ void fla_test_gesv_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -131,11 +127,19 @@ void fla_test_gesv_experiment(test_params_t *params, n = p_cur; lda = params->lin_solver_paramslist[pci].lda; ldb = params->lin_solver_paramslist[pci].ldb; - - if(lda < n || ldb < n) + + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } + if (ldb == -1) + { + ldb = fla_max(1,n); + } } /* Create the matrices for the current operation*/ @@ -145,18 +149,8 @@ void fla_test_gesv_experiment(test_params_t *params, create_matrix(datatype, &B, ldb, NRHS); create_matrix(datatype, &B_save, ldb, NRHS); /* Initialize the test matrices*/ - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - init_matrix_from_file(datatype, B, n, NRHS, ldb, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, n, n, lda); - rand_matrix(datatype, B, n, NRHS, ldb); - } + init_matrix(datatype, A, n, n, lda, g_ext_fptr, params->imatrix_char); + init_matrix(datatype, B, n, NRHS, ldb, g_ext_fptr, params->imatrix_char); /* Save the original matrix*/ copy_matrix(datatype, "full", n, n, A, lda, A_save, lda); copy_matrix(datatype, "full", n, NRHS, B, ldb, B_save, ldb); @@ -175,9 +169,7 @@ void fla_test_gesv_experiment(test_params_t *params, if(info == 0) validate_gesv(n, NRHS, A, lda, B, ldb, B_save, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -208,7 +200,7 @@ void prepare_gesv_run(integer n_A, create_matrix(datatype, &A_test, lda, n_A); create_matrix(datatype, &B_test, ldb, nrhs); - + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { diff --git a/test/main/src/test_gesvd.c b/test/main/src/test_gesvd.c index c30614a34..696c54d01 100644 --- a/test/main/src/test_gesvd.c +++ b/test/main/src/test_gesvd.c @@ -8,26 +8,20 @@ #include "test_prototype.h" /* Local prototypes */ -void fla_test_gesvd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, double* perf, double* t, double* residual); +void fla_test_gesvd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gesvd_run(char *jobu, char *jobvt, integer m_A, integer n_A, void *A, integer lda, void *s, void *U, integer ldu, void *V, integer ldvt, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_gesvd(integer datatype, char* jobu, char *jobvt, integer* m, integer* n, void* a, integer* lda, void* s, void* u, integer* ldu, void* vt, integer* ldvt, void* work, integer* lwork, void* rwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_gesvd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Singular value decomposition"; char* front_str = "GESVD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, SVD, fla_test_gesvd_experiment); @@ -35,13 +29,7 @@ void fla_test_gesvd(integer argc, char ** argv, test_params_t *params) } if (argc == 13) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[12], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[12]); } if (argc >= 12 && argc <= 13) { @@ -89,7 +77,7 @@ void fla_test_gesvd(integer argc, char ** argv, test_params_t *params) fla_test_gesvd_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -107,7 +95,7 @@ void fla_test_gesvd(integer argc, char ** argv, test_params_t *params) if(tests_not_run) { printf("\nIllegal arguments for gesdd\n"); - printf("./ gesvd \n"); + printf("./ gesvd \n"); } if(invalid_dtype) { @@ -116,6 +104,7 @@ void fla_test_gesvd(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -127,6 +116,7 @@ void fla_test_gesvd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -148,10 +138,45 @@ void fla_test_gesvd_experiment(test_params_t *params, ldu = params->svd_paramslist[pci].ldu; ldvt = params->svd_paramslist[pci].ldvt; - if(lda < m || ldu < m || ldvt < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } + /* LDU >= 1; + if JOBU = 'S' or 'A', LDU >= M. */ + if (ldu == -1) + { + if ((jobu == 'S') || (jobu == 'A')) + { + ldu = m; + } + else + { + ldu = 1; + } + } + /* LDVT >= 1; + if JOBVT = 'A', LDVT >= N; + if JOBVT = 'S', LDVT >= min(M,N)*/ + if (ldvt == -1) + { + if (jobvt == 'A') + { + ldvt = n; + } + else if (jobvt == 'S') + { + ldvt = fla_min(m,n); + } + else + { + ldvt = 1; + } + } } /* Create input matrix parameters. */ @@ -160,16 +185,7 @@ void fla_test_gesvd_experiment(test_params_t *params, create_matrix(datatype, &V, ldvt, n); create_realtype_vector(datatype, &s, fla_min(m, n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality. */ create_matrix(datatype, &A_test, lda, n); @@ -202,9 +218,7 @@ void fla_test_gesvd_experiment(test_params_t *params, if((jobu == 'A' && jobvt == 'A') && info == 0) validate_gesvd(&jobu, &jobvt, m, n, A, A_test, lda, s, U, ldu, V, ldvt, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails*/ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -256,15 +270,12 @@ void prepare_gesvd_run(char *jobu, char *jobvt, /* call gesvd API */ invoke_gesvd(datatype, jobu, jobvt, &m_A, &n_A, NULL, &lda, NULL, NULL, &ldu, NULL, &ldvt, work, &lwork, NULL, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + /* Get the work size */ + lwork = get_work_value( datatype, work ); } - /* Get the work size */ - lwork = get_work_value( datatype, work ); free_vector(work); } else @@ -272,6 +283,7 @@ void prepare_gesvd_run(char *jobu, char *jobvt, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_getrf.c b/test/main/src/test_getrf.c index 02b716644..6ca288818 100644 --- a/test/main/src/test_getrf.c +++ b/test/main/src/test_getrf.c @@ -6,18 +6,17 @@ /* Local prototypes */ void fla_test_getrf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_getrf_run(integer m_A, integer n_A, void *A, integer lda, integer* ipiv, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_getrf(integer datatype, integer *m, integer *n, void *a, integer *lda, integer *ipiv, integer *info); -static FILE* g_ext_fptr = NULL; - void fla_test_getrf(integer argc, char ** argv, test_params_t *params) { char* op_str = "LU factorization"; char* front_str = "GETRF"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_getrf_experiment); @@ -25,13 +24,7 @@ void fla_test_getrf(integer argc, char ** argv, test_params_t *params) } if (argc == 8) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[7]); } if (argc >= 7 && argc <= 8) { @@ -74,7 +67,7 @@ void fla_test_getrf(integer argc, char ** argv, test_params_t *params) fla_test_getrf_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -101,6 +94,7 @@ void fla_test_getrf(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -112,6 +106,7 @@ void fla_test_getrf_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -126,11 +121,16 @@ void fla_test_getrf_experiment(test_params_t *params, m = p_cur; n = q_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } /* Create the matrices for the current operation*/ @@ -138,16 +138,7 @@ void fla_test_getrf_experiment(test_params_t *params, create_vector(INTEGER, &IPIV, fla_min(m, n)); /* Initialize the test matrices*/ - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Save the original matrix*/ create_matrix(datatype, &A_test, lda, n); @@ -179,9 +170,7 @@ void fla_test_getrf_experiment(test_params_t *params, if (info == 0) validate_getrf(m, n, A, A_test, lda, IPIV, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -207,6 +196,7 @@ void prepare_getrf_run(integer m_A, create_matrix(datatype, &A_save, lda, n_A); copy_matrix(datatype, "full", m_A, n_A, A, lda, A_save, lda); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { diff --git a/test/main/src/test_getri.c b/test/main/src/test_getri.c index 91459cce4..5065cc5da 100644 --- a/test/main/src/test_getri.c +++ b/test/main/src/test_getri.c @@ -6,26 +6,19 @@ /* Local prototypes */ void fla_test_getri_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_getri_run(integer m_A, integer n_A, void *A, integer lda, integer* ipiv, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_getri(integer datatype, integer *n, void *a, integer *lda, integer *ipiv, void *work, integer *lwork, integer *info); - -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_getri(integer argc, char ** argv, test_params_t *params) { char* op_str = "Inverse through LU factorization"; char* front_str = "GETRI"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_getri_experiment); @@ -33,13 +26,7 @@ void fla_test_getri(integer argc, char ** argv, test_params_t *params) } if(argc == 8) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[7]); } if(argc >= 7 && argc <= 8) { @@ -82,7 +69,7 @@ void fla_test_getri(integer argc, char ** argv, test_params_t *params) fla_test_getri_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -109,6 +96,7 @@ void fla_test_getri(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -121,6 +109,7 @@ void fla_test_getri_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -134,27 +123,23 @@ void fla_test_getri_experiment(test_params_t *params, /* Determine the dimensions*/ n = p_cur; lda = params->lin_solver_paramslist[pci].lda; + *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } } /* Create the matrices for the current operation*/ create_matrix(datatype, &A, lda, n); create_vector(INTEGER, &IPIV, n); /* Initialize the test matrices*/ - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, n, n, lda); - } + init_matrix(datatype, A, n, n, lda, g_ext_fptr, params->imatrix_char); /* Save the original matrix*/ create_matrix(datatype, &A_test, lda, n); @@ -176,9 +161,7 @@ void fla_test_getri_experiment(test_params_t *params, if (info == 0) validate_getri(n, n, A, A_test, lda, IPIV, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -213,16 +196,12 @@ void prepare_getri_run(integer m_A, // call to getri API invoke_getri(datatype, &n_A, NULL, &lda, NULL, work, &lwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_vector(work); - return; + // Get work siz`e + lwork = get_work_value(datatype, work); } - // Get work size - lwork = get_work_value(datatype, work); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -232,6 +211,7 @@ void prepare_getri_run(integer m_A, lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { @@ -243,12 +223,7 @@ void prepare_getri_run(integer m_A, /* call to API getrf to get AFACT */ invoke_getrf(datatype, &m_A, &n_A, A_save, &lda, IPIV, info); - if(*info < 0) - { - free_matrix(work); - free_matrix(A_save); - return; - } + /* call getri API with AFACT to get A INV */ invoke_getri(datatype, &n_A, A_save, &lda, IPIV, work, &lwork, info); diff --git a/test/main/src/test_getrs.c b/test/main/src/test_getrs.c index 49f49e52f..b16109371 100644 --- a/test/main/src/test_getrs.c +++ b/test/main/src/test_getrs.c @@ -6,20 +6,19 @@ /* Local prototypes */ void fla_test_getrs_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_getrs_run(char *trans, integer m_A, integer n_A, void *A, integer lda, void *B, integer ldb, integer* ipiv, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_getrs(integer datatype, char *trans, integer *nrhs, integer *n, void *a, integer *lda, integer *ipiv, void *b, integer *ldb, integer *info); -static FILE* g_ext_fptr = NULL; - void fla_test_getrs(integer argc, char ** argv, test_params_t *params) { char* op_str = "LU factorization"; char* front_str = "GETRS"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_getrs_experiment); @@ -27,13 +26,7 @@ void fla_test_getrs(integer argc, char ** argv, test_params_t *params) } if(argc == 10) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[9], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[9]); } if(argc >= 9 && argc <= 10) { @@ -79,7 +72,7 @@ void fla_test_getrs(integer argc, char ** argv, test_params_t *params) fla_test_getrs_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -106,6 +99,7 @@ void fla_test_getrs(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -118,6 +112,7 @@ void fla_test_getrs_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -136,10 +131,18 @@ void fla_test_getrs_experiment(test_params_t *params, lda = params->lin_solver_paramslist[pci].lda; ldb = params->lin_solver_paramslist[pci].ldb; - if(lda < n || ldb < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } + if (ldb == -1) + { + ldb = fla_max(1,n); + } } /* Create the matrices for the current operation*/ @@ -150,18 +153,8 @@ void fla_test_getrs_experiment(test_params_t *params, create_matrix(datatype, &X, n, NRHS); create_matrix(datatype, &A_test, lda, n); /* Initialize the test matrices*/ - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - init_matrix_from_file(datatype, B, n, NRHS, ldb, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, n, n, lda); - rand_matrix(datatype, B, n, NRHS, ldb); - } + init_matrix(datatype, A, n, n, lda, g_ext_fptr, params->imatrix_char); + init_matrix(datatype, B, n, NRHS, ldb, g_ext_fptr, params->imatrix_char); /* Save the original matrix*/ @@ -170,17 +163,7 @@ void fla_test_getrs_experiment(test_params_t *params, /* call to API getrf to get AFACT */ invoke_getrf(datatype, &n, &n, A_test, &lda, IPIV, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(A); - free_matrix(A_test); - free_vector(IPIV); - free_matrix(B); - free_matrix(X); - free_matrix(B_save); - return; - } + /* call to API */ prepare_getrs_run(&TRANS, n, NRHS, A_test, lda, B, ldb, IPIV, datatype, n_repeats, &time_min, &info); copy_matrix(datatype, "full", n, NRHS, B, ldb, X, n); @@ -197,10 +180,8 @@ void fla_test_getrs_experiment(test_params_t *params, if(info == 0) validate_getrs(&TRANS, n, NRHS, A, lda, B_save, ldb, X, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; - + FLA_TEST_CHECK_EINFO(residual, info, einfo); + /* Free up the buffers */ free_matrix(A); free_matrix(A_test); @@ -234,6 +215,7 @@ void prepare_getrs_run(char *TRANS, create_matrix(datatype, &B_test, ldb, nrhs); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Copy original input data */ diff --git a/test/main/src/test_ggev.c b/test/main/src/test_ggev.c index 0a03d4450..788827fd9 100644 --- a/test/main/src/test_ggev.c +++ b/test/main/src/test_ggev.c @@ -7,27 +7,21 @@ /* Local prototypes */ -void fla_test_ggev_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, double* perf, double* t, double* residual); +void fla_test_ggev_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_ggev_run(char *jobvl, char *jobvr, integer n, void *a, integer lda, void *b, integer ldb, void* alpha, void * alphar, void * alphai, void *beta, void *vl, integer ldvl, void *vr, integer ldvr, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_ggev(integer datatype, char* jobvl, char* jobvr, integer* n, void* a, integer* lda, void* b, integer* ldb, integer* alpha, integer* alphar, integer* alphai, integer* beta, void* vl, integer* ldvl, void* vr, integer* ldvr, void* work, integer* lwork, void* rwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_ggev(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computing Eigen value and Eigen vectors"; char* front_str = "GGEV"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_NSYM, fla_test_ggev_experiment); @@ -35,13 +29,7 @@ void fla_test_ggev(integer argc, char ** argv, test_params_t *params) } if (argc == 13) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[12], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[12]); } if (argc >= 12 && argc <= 13) { @@ -90,7 +78,7 @@ void fla_test_ggev(integer argc, char ** argv, test_params_t *params) fla_test_ggev_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -117,6 +105,7 @@ void fla_test_ggev(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -128,6 +117,7 @@ void fla_test_ggev_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *t, double *residual) @@ -151,10 +141,44 @@ void fla_test_ggev_experiment(test_params_t *params, ldvl = params->eig_non_sym_paramslist[pci].ldvl; ldvr = params->eig_non_sym_paramslist[pci].ldvr; - if(lda < m || ldb < m || ldvl < m || ldvr < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } + if (ldb == -1) + { + ldb = fla_max(1,m); + } + /* LDVL >= 1, and + if JOBVL = 'V', LDVL >= M */ + if (ldvl == -1) + { + if (JOBVL == 'V') + { + ldvl = m; + } + else + { + ldvl = 1; + } + } + /* LDVR >= 1, and + if JOBVR = 'V', LDVR >= M */ + if (ldvr == -1) + { + if (JOBVR == 'V') + { + ldvr = m; + } + else + { + ldvr = 1; + } + } } /* Create input matrix parameters */ @@ -173,18 +197,8 @@ void fla_test_ggev_experiment(test_params_t *params, } create_vector(datatype, &beta, m); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, m, lda, g_ext_fptr); - init_matrix_from_file(datatype, B, m, m, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, m, lda); - rand_matrix(datatype, B, m, m, lda); - } + init_matrix(datatype, A, m, m, lda, g_ext_fptr, params->imatrix_char); + init_matrix(datatype, B, m, m, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality */ create_matrix(datatype, &A_test, lda, m); @@ -206,10 +220,8 @@ void fla_test_ggev_experiment(test_params_t *params, /* output validation */ if ((JOBVL == 'V' && JOBVR == 'V') && info == 0) validate_ggev(&JOBVL, &JOBVR, m, A, lda, B, ldb, alpha, alphar, alphai, beta, VL, ldvl, VR, ldvr, datatype, residual, &vinfo); - - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -258,17 +270,12 @@ void prepare_ggev_run(char *jobvl, char *jobvr, integer n_A, void *A, integer ld /* call to ggev API to get work query */ invoke_ggev(datatype, jobvl, jobvr, &n_A, NULL, &lda, NULL, &ldb, NULL, NULL, NULL, NULL, NULL, &ldvl, NULL, &ldvr, work, &lwork, rwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_matrix(B_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work); } - /* Get work size */ - lwork = get_work_value( datatype, work); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -278,6 +285,7 @@ void prepare_ggev_run(char *jobvl, char *jobvr, integer n_A, void *A, integer ld lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers for each iteration */ diff --git a/test/main/src/test_ggevx.c b/test/main/src/test_ggevx.c index 9e74378b7..f1b9f5cc1 100644 --- a/test/main/src/test_ggevx.c +++ b/test/main/src/test_ggevx.c @@ -8,7 +8,7 @@ /* Local prototypes */ void fla_test_ggevx_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_ggevx_run(char* balanc, char* jobvl, char* jobvr, char* sense, integer n_A, void* A, integer lda, void* B, integer ldb, void* alpha, void* alphar, void* alphai, void* beta, void* VL, integer ldvl, void* VR, integer ldvr, @@ -19,23 +19,17 @@ void invoke_ggevx(integer datatype, char* balanc, char* jobvl, char* jobvr, char void* vr, integer* ldvr, integer* ilo, integer* ihi, void* lscale, void* rscale, void* abnrm, void* bbnrm, void* rconde, void* rcondv, void* work, integer* lwork, void* rwork, integer* iwork, integer* bwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_ggevx(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computing Eigen value and Eigen vectors with condition numbers"; char* front_str = "GGEVX"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { /* Test with parameters from config */ g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_NSYM, fla_test_ggevx_experiment); @@ -43,13 +37,7 @@ void fla_test_ggevx(integer argc, char ** argv, test_params_t *params) } if(argc == 15) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[14], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[14]); } if(argc >= 14 && argc <= 15) { @@ -99,7 +87,7 @@ void fla_test_ggevx(integer argc, char ** argv, test_params_t *params) fla_test_ggevx_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -126,6 +114,7 @@ void fla_test_ggevx(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -138,6 +127,7 @@ void fla_test_ggevx_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *t, double *residual) @@ -161,10 +151,44 @@ void fla_test_ggevx_experiment(test_params_t *params, ldvr = params->eig_non_sym_paramslist[pci].ldvr; ldb = params->eig_non_sym_paramslist[pci].ldb; - if(lda < n || ldb < n || ldvl < n || ldvr < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } + if (ldb == -1) + { + ldb = fla_max(1,n); + } + /* LDVL >= 1, and + if JOBVL = 'V', LDVL >= N */ + if (ldvl == -1) + { + if (JOBVL == 'V') + { + ldvl = n; + } + else + { + ldvl = 1; + } + } + /* LDVR >= 1, and + if JOBVR = 'V', LDVR >= N */ + if (ldvr == -1) + { + if (JOBVR == 'V') + { + ldvr = n; + } + else + { + ldvr = 1; + } + } } /* Create input matrix parameters */ @@ -192,18 +216,9 @@ void fla_test_ggevx_experiment(test_params_t *params, create_realtype_vector(datatype, &bbnrm, 1); - if(g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - init_matrix_from_file(datatype, B, n, n, ldb, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, n, n, lda); - rand_matrix(datatype, B, n, n, ldb); - } + init_matrix(datatype, A, n, n, lda, g_ext_fptr, params->imatrix_char); + init_matrix(datatype, B, n, n, ldb, g_ext_fptr, params->imatrix_char); + /* Make a copy of input matrix A. This is required to validate the API functionality */ create_matrix(datatype, &A_test, lda, n); create_matrix(datatype, &B_test, ldb, n); @@ -226,9 +241,7 @@ void fla_test_ggevx_experiment(test_params_t *params, if((JOBVL == 'V' || JOBVR == 'V') && info == 0) validate_ggevx(&BALANC, &JOBVL, &JOBVR, &SENSE, n, A_test, lda, B_test, ldb, alpha, alphar, alphai, beta, VL, ldvl, VR, ldvr, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -293,17 +306,12 @@ void prepare_ggevx_run(char* balanc, char* jobvl, char* jobvr, char* sense, inte /* call to ggevx API */ invoke_ggevx(datatype, balanc, jobvl, jobvr, sense, &n_A, A, &lda, B, &ldb, alpha, alphar, alphai, beta, VL, &ldvl, VR, &ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, &lwork, rwork, iwork, bwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(A_save); - free_matrix(B_save); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value( datatype, work); } - /* Get work size */ - lwork = get_work_value( datatype, work); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -316,6 +324,7 @@ void prepare_ggevx_run(char* balanc, char* jobvl, char* jobvr, char* sense, inte create_realtype_vector(datatype, &rwork, 8 * n_A); + *info = 0; for(i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers for each iteration */ diff --git a/test/main/src/test_gghrd.c b/test/main/src/test_gghrd.c index aaa18ee35..896c5e737 100644 --- a/test/main/src/test_gghrd.c +++ b/test/main/src/test_gghrd.c @@ -8,22 +8,22 @@ /* Local prototypes */ void fla_test_gghrd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_gghrd_run(char* compq, char* compz, integer n, integer* ilo, integer* ihi, void* a, integer lda, void* b, integer ldb, void* q, integer ldq, void* z, integer ldz, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_gghrd(integer datatype, char* compq, char* compz, integer* n, integer* ilo, integer* ihi, void* a, integer* lda, void* b, integer* ldb, void* q, integer* ldq, void* z, integer* ldz, integer* info); -static FILE* g_ext_fptr = NULL; void fla_test_gghrd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Reduces a pair matrices (A,B) to generalized upper Hessenberg form"; char* front_str = "GGHRD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_gghrd_experiment); @@ -31,13 +31,7 @@ void fla_test_gghrd(integer argc, char ** argv, test_params_t *params) } if(argc == 14) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[13], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[13]); } if(argc >= 13 && argc <=14) { @@ -85,7 +79,7 @@ void fla_test_gghrd(integer argc, char ** argv, test_params_t *params) fla_test_gghrd_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -112,6 +106,7 @@ void fla_test_gghrd(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -122,6 +117,7 @@ void fla_test_gghrd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *time_min, double *residual) @@ -138,12 +134,6 @@ void fla_test_gghrd_experiment(test_params_t *params, ldq = params->lin_solver_paramslist[pci].ldq; ldz = params->lin_solver_paramslist[pci].ldz; - if(lda < n || ldq < n || ldz < n || ldb < n) - { - *residual = DBL_MIN; - return; - } - /* Initialize parameter */ compz = params->lin_solver_paramslist[pci].compz_gghrd; compq = params->lin_solver_paramslist[pci].compq_gghrd; @@ -151,6 +141,44 @@ void fla_test_gghrd_experiment(test_params_t *params, ilo = params->lin_solver_paramslist[pci].ilo; ihi = params->lin_solver_paramslist[pci].ihi; + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (lda == -1) + { + lda = fla_max(1,n); + } + if (ldb == -1) + { + ldb = fla_max(1,n); + } + /* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise */ + if (ldq == -1) + { + if ((compq == 'V') || (compq == 'I')) + { + ldq = n; + } + else + { + ldq = 1; + } + } + /* LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise */ + if (ldz == -1) + { + if ((compz == 'V') || (compz == 'I')) + { + ldz = n; + } + else + { + ldz = 1; + } + } + } + /* Create input matrix parameters*/ create_matrix(datatype, &A, lda, n); create_matrix(datatype, &B, ldb, n); @@ -168,15 +196,6 @@ void fla_test_gghrd_experiment(test_params_t *params, { rand_matrix(datatype, B, n, n, ldb); get_orthogonal_matrix_from_QR(datatype, n, B, ldb, Q, ldq, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(A); - free_matrix(B); - free_matrix(Q); - free_matrix(Z); - return; - } if(compq == 'I') set_identity_matrix(datatype, n, n, Q, ldq); get_generic_triangular_matrix(datatype, n, A, lda, ilo, ihi); @@ -193,7 +212,7 @@ void fla_test_gghrd_experiment(test_params_t *params, copy_matrix(datatype, "full", n, n, Q, ldq, Q_test, ldq); copy_matrix(datatype, "full", n, n, Z, ldz, Z_test, ldz); - prepare_gghrd_run(&compq, &compq, n, &ilo, &ihi, A_test, lda, B_test, ldb, Q_test, ldq, Z_test, ldz, datatype, n_repeats, time_min, &info); + prepare_gghrd_run(&compq, &compz, n, &ilo, &ihi, A_test, lda, B_test, ldb, Q_test, ldq, Z_test, ldz, datatype, n_repeats, time_min, &info); /* Performance computation (7)n^3 flops for eigen vectors for real @@ -228,8 +247,8 @@ void fla_test_gghrd_experiment(test_params_t *params, /* Output Validation */ if(info == 0) validate_gghrd(&compq, &compz, n, A, A_test, lda, B, B_test, ldb, Q, Q_test, ldq, Z, Z_test, ldz, datatype, residual, &vinfo); - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -260,6 +279,7 @@ void prepare_gghrd_run(char* compq, char* compz, integer n, integer* ilo, intege copy_matrix(datatype, "full", n, n, Q, ldq, Q_save, ldq); copy_matrix(datatype, "full", n, n, Z, ldz, Z_save, ldz); + *info = 0; for(i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A,B,Q and Z value and allocate memory to output buffers diff --git a/test/main/src/test_hgeqz.c b/test/main/src/test_hgeqz.c index de9df9cd3..656a268a4 100644 --- a/test/main/src/test_hgeqz.c +++ b/test/main/src/test_hgeqz.c @@ -8,27 +8,22 @@ /* Local prototypes */ void fla_test_hgeqz_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_hgeqz_run(char* job, char* compq, char* compz, integer n, integer* ilo, integer* ihi, void* h, integer ldh, void* t, integer ldt, void *alpha, void *alphar, void *alphai, void* beta, void* q, integer ldq, void* z, integer ldz, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_hgeqz(integer datatype, char* job, char* compq, char* compz, integer* n, integer* ilo, integer* ihi, void* h, integer* ldh, void* t, integer* ldt, void *alpha, void *alphar, void *alphai, void* beta, void* q, integer* ldq, void* z, integer* ldz, void* work, integer* lwork, void* rwork, integer* info); -static FILE* g_ext_fptr = NULL; -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; void fla_test_hgeqz(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computing Eigen value of a real matrix pair (H,T)"; char* front_str = "HGEQZ"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_hgeqz_experiment); @@ -36,13 +31,7 @@ void fla_test_hgeqz(integer argc, char ** argv, test_params_t *params) } if(argc == 16) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[15], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[15]); } if(argc >= 15 && argc <=16) { @@ -92,7 +81,7 @@ void fla_test_hgeqz(integer argc, char ** argv, test_params_t *params) fla_test_hgeqz_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -119,6 +108,7 @@ void fla_test_hgeqz(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } } @@ -128,6 +118,7 @@ void fla_test_hgeqz_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *time_min, double *residual) @@ -135,7 +126,7 @@ void fla_test_hgeqz_experiment(test_params_t *params, integer n, ldz, ldh, ldt, ldq; integer ilo, ihi, info = 0, vinfo = 0; void *H = NULL, *Z = NULL, *Q = NULL, *T = NULL, *H_test = NULL, *T_test = NULL, *A = NULL; - void *B = NULL, *Z_A = NULL, *Q_test = NULL, *Z_test = NULL; + void *B = NULL, *Z_A = NULL, *Q_test = NULL, *Z_test = NULL, *Q_temp = NULL; void *alpha = NULL, *alphar = NULL, *alphai = NULL, *beta = NULL, *scale = NULL, *Q_A = NULL; char compz, compq, job; @@ -146,12 +137,6 @@ void fla_test_hgeqz_experiment(test_params_t *params, ldq = params->eig_sym_paramslist[pci].ldq; ldz = params->eig_sym_paramslist[pci].ldz; - if(ldh < n || ldq < n || ldz < n || ldt < n) - { - *residual = DBL_MIN; - return; - } - /* Initialize parameters */ job = params->eig_sym_paramslist[pci].job_seqr; compz = params->eig_sym_paramslist[pci].compz_hgeqz; @@ -160,6 +145,44 @@ void fla_test_hgeqz_experiment(test_params_t *params, ilo = params->eig_sym_paramslist[pci].ilo; ihi = params->eig_sym_paramslist[pci].ihi; + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (ldh == -1) + { + ldh = fla_max(1,n); + } + if (ldt == -1) + { + ldt = fla_max(1,n); + } + /* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise */ + if (ldq == -1) + { + if ((compq == 'V') || (compq == 'I')) + { + ldq = n; + } + else + { + ldq = 1; + } + } + /* LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise */ + if (ldz == -1) + { + if ((compz == 'V') || (compz == 'I')) + { + ldz = n; + } + else + { + ldz = 1; + } + } + } + /* Create input matrix */ create_matrix(datatype, &H, ldh, n); create_matrix(datatype, &T, ldt, n); @@ -194,7 +217,17 @@ void fla_test_hgeqz_experiment(test_params_t *params, /* Initialize matrix with random values */ rand_matrix(datatype, B, n, n, ldt); /* Decompose matrix B in to QR and store orthogonal matrix in Q and R in B */ - get_orthogonal_matrix_from_QR(datatype, n, B, ldt, Q, ldq, &info); + if(compq == 'N') + { + create_matrix(datatype, &Q_temp, ldt, n); + get_orthogonal_matrix_from_QR(datatype, n, B, ldt, Q_temp, ldt, &info); + free_matrix(Q_temp); + } + else + { + get_orthogonal_matrix_from_QR(datatype, n, B, ldt, Q, ldq, &info); + } + info = 0; /* Make copy of matrix A and B. This is required to validate the API functionality */ copy_matrix(datatype, "full", n, n, A, ldh, H, ldh); copy_matrix(datatype, "full", n, n, B, ldt, T, ldt); @@ -206,27 +239,6 @@ void fla_test_hgeqz_experiment(test_params_t *params, copy_matrix(datatype, "full", n, n, Z, ldz, Z_A, ldz); /* Call to GGHRD API */ invoke_gghrd(datatype, &compq, &compz, &n, &ilo, &ihi, H, &ldh, T, &ldt, Q, &ldq, Z, &ldz, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(H); - free_matrix(T); - free_matrix(Q); - free_matrix(Z); - free_matrix(A); - free_matrix(B); - free_matrix(Q_A); - free_matrix(Z_A); - if (datatype == FLOAT || datatype == DOUBLE) - { - free_vector(alphar); - free_vector(alphai); - } - else - free_vector(alpha); - free_vector(beta); - return; - } if(compq == 'I') set_identity_matrix(datatype, n, n, Q, ldq); if(compz == 'I') @@ -279,8 +291,8 @@ void fla_test_hgeqz_experiment(test_params_t *params, /* Output Validation */ if(info == 0) validate_hgeqz(&job, &compq, &compz, n, H, H_test, A, ldh, T, T_test, B, ldt, Q, Q_test, Q_A, ldq, Z, Z_test, Z_A, ldz, datatype, residual, &vinfo); - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_vector(scale); @@ -291,6 +303,12 @@ void fla_test_hgeqz_experiment(test_params_t *params, free_matrix(Z); free_matrix(H_test); free_matrix(T_test); + free_matrix(Q_test); + free_matrix(Z_test); + free_matrix(A); + free_matrix(B); + free_matrix(Q_A); + free_matrix(Z_A); if (datatype == FLOAT || datatype == DOUBLE) { free_vector(alphar); @@ -338,21 +356,13 @@ void prepare_hgeqz_run(char* job, char* compq, char* compz, integer n, integer* lwork = get_work_value( datatype, work ); free_vector(work); } - else - { - free_vector(work); - free_matrix(H_save); - free_matrix(T_save); - free_matrix(Q_save); - free_matrix(Z_save); - return; - } } else { lwork = g_lwork; } + *info = 0; for(i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix H and Z value and allocate memory to output buffers diff --git a/test/main/src/test_hseqr.c b/test/main/src/test_hseqr.c index 36aaa14fb..837a372a9 100644 --- a/test/main/src/test_hseqr.c +++ b/test/main/src/test_hseqr.c @@ -8,25 +8,20 @@ /* Local prototypes */ void fla_test_hseqr_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_hseqr_run(char* job, char* compz, integer n, integer* ilo, integer* ihi, void* h, integer ldh, void *w, void *wr, void* wi, void* z, integer ldz, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_hseqr(integer datatype,char* job, char* compz, integer* n, integer* ilo, integer* ihi, void* h, integer* ldh, void *w, void *wr, void* wi, void* z, integer* ldz, void* work, integer* lwork, integer* info); -static FILE* g_ext_fptr = NULL; -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; void fla_test_hseqr(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computing Eigen value of a Hessenberg matrix"; char* front_str = "HSEQR"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_hseqr_experiment); @@ -34,13 +29,7 @@ void fla_test_hseqr(integer argc, char ** argv, test_params_t *params) } if(argc == 13) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[12], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[12]); } if(argc >= 12 && argc <=13) { @@ -87,7 +76,7 @@ void fla_test_hseqr(integer argc, char ** argv, test_params_t *params) fla_test_hseqr_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -114,6 +103,7 @@ void fla_test_hseqr(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } } @@ -123,6 +113,7 @@ void fla_test_hseqr_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double *perf, double *time_min, double *residual) @@ -138,12 +129,6 @@ void fla_test_hseqr_experiment(test_params_t *params, ldz = params->eig_sym_paramslist[pci].ldz; ldh = params->eig_sym_paramslist[pci].lda; - if(ldz < n || ldh < n) - { - *residual = DBL_MIN; - return; - } - /* Initialize parameter needed for HSEQR() call. */ job = params->eig_sym_paramslist[pci].job_seqr; compz = params->eig_sym_paramslist[pci].compz_hseqr; @@ -151,6 +136,29 @@ void fla_test_hseqr_experiment(test_params_t *params, ilo = params->eig_sym_paramslist[pci].ilo; ihi = params->eig_sym_paramslist[pci].ihi; + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (ldh == -1) + { + ldh = fla_max(1,n); + } + /* if COMPZ = 'I' or COMPZ = 'V', then LDZ >= MAX(1,N) + Otherwise, LDZ >= 1 */ + if (ldz == -1) + { + if ((compz == 'I') || (compz == 'V')) + { + ldz = fla_max(1,n); + } + else + { + ldz = 1; + } + } + } + /* Create input matrix parameters*/ create_matrix(datatype, &H, ldh, n); create_matrix(datatype, &Z, ldz, n); @@ -175,23 +183,6 @@ void fla_test_hseqr_experiment(test_params_t *params, { /* Generate Hessenberg matrix H */ get_hessenberg_matrix(datatype, n, H, ldh, Z, ldz, &ilo, &ihi, scale, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_vector(scale); - free_matrix(H); - free_matrix(Z); - if(datatype == COMPLEX || datatype == DOUBLE_COMPLEX) - { - free_vector(w); - } - else - { - free_vector(wr); - free_vector(wi); - } - return; - } if(compz == 'I') set_identity_matrix(datatype, n, n, Z, ldz); } @@ -237,8 +228,10 @@ void fla_test_hseqr_experiment(test_params_t *params, /* Output Validation */ if(info == 0) validate_hseqr(&job, &compz, n, H, H_test, ldh, Z, Z_Test, ldz, datatype, residual, &vinfo); - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + + /* test info only for negative test cases */ + if(info < 0) + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_vector(scale); @@ -257,9 +250,22 @@ void fla_test_hseqr_experiment(test_params_t *params, } } -void prepare_hseqr_run(char* job, char* compz, integer n, integer* ilo, integer* ihi, void* H, integer ldh, - void *w, void *wr, void* wi, void* Z, integer ldz, integer datatype, - integer n_repeats, double* time_min_, integer* info) +void prepare_hseqr_run(char* job, + char* compz, + integer n, + integer* ilo, + integer* ihi, + void* H, + integer ldh, + void *w, + void *wr, + void* wi, + void* Z, + integer ldz, + integer datatype, + integer n_repeats, + double* time_min_, + integer* info) { void *H_save = NULL, *work = NULL, *Z_save = NULL; integer i, lwork; @@ -288,21 +294,16 @@ void prepare_hseqr_run(char* job, char* compz, integer n, integer* ilo, integer* { /* Get work size */ lwork = get_work_value( datatype, work ); - free_vector(work); - } - else - { - free_vector(work); - free_matrix(H_save); - free_matrix(Z_save); - return; } + + free_vector(work); } else { lwork = g_lwork; } + *info = 0; for(i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix H and Z value and allocate memory to output buffers diff --git a/test/main/src/test_lapack.c b/test/main/src/test_lapack.c index 3d5f2d5d3..f2df70509 100644 --- a/test/main/src/test_lapack.c +++ b/test/main/src/test_lapack.c @@ -8,11 +8,17 @@ // Global variables. int n_threads = 1; + +char *LINEAR_PARAMETERS_FILENAME = NULL; +char *SYM_EIG_PARAMETERS_FILENAME = NULL; +char *SVD_PARAMETERS_FILENAME = NULL; +char *NON_SYM_EIG_PARAMETERS_FILENAME = NULL; +char *AUX_PARAMETERS_FILENAME = NULL; + char fla_test_binary_name[ MAX_BINARY_NAME_LENGTH + 1 ]; char fla_test_pass_string[ MAX_PASS_STRING_LENGTH + 1 ]; char fla_test_warn_string[ MAX_PASS_STRING_LENGTH + 1 ]; char fla_test_fail_string[ MAX_PASS_STRING_LENGTH + 1 ]; -char fla_test_incomplete_string [ MAX_PASS_STRING_LENGTH + 1]; char fla_test_invalid_string [ MAX_PASS_STRING_LENGTH + 1]; char fla_test_storage_format_string[ 200 ]; char fla_test_stor_chars[ NUM_STORAGE_CHARS + 1 ]; @@ -25,6 +31,23 @@ integer tests_passed[4]; integer tests_failed[4]; integer tests_incomplete[4]; +/* Flag to indicate lwork/liwork/lrwork availability status + * <= 0 - To be calculated + * > 0 - Use the value + * */ +integer g_lwork = -1; +integer g_liwork= -1; +integer g_lrwork= -1; +/* Variable to indicate the source of inputs + * = 0 - Inputs are from command line + * = 1 - Inputs are from config file + * */ +integer config_data = 0; +/* File pointer for external file which is used + * to pass the input matrix values + * */ +FILE* g_ext_fptr = NULL; + #define SKIP_EXTRA_LINE_READ() \ eol = fgetc(fp); \ if(eol != '\n') \ @@ -38,6 +61,8 @@ integer tests_incomplete[4]; break; \ } \ +int fla_check_cmd_config_dir( int argc, char** argv ); + #if AOCL_FLA_SET_PROGRESS_ENABLE == 1 int aocl_fla_progress(const char* const api,const integer lenapi,const integer* const progress,const integer* const current_thread,const integer* const total_threads) { @@ -79,12 +104,15 @@ int main( int argc, char** argv ) } } + /* Checking for the cmd option or config file option */ + int cmd_option = fla_check_cmd_config_dir(argc,argv); + /* Check for Command line requests */ - if ( argc > 1 ) + if ( cmd_option == 1) { fla_test_execute_cli_api(argc, argv, ¶ms); } - else + else if(cmd_option == 0) { printf(" LAPACK version: %"FT_IS".%"FT_IS".%"FT_IS" \n", vers_major, vers_minor, vers_patch); /* Copy the binary name to a global string so we can use it later. */ @@ -100,17 +128,176 @@ int main( int argc, char** argv ) /* Read SVD parameters from config file */ fla_test_read_svd_params ( SVD_PARAMETERS_FILENAME, ¶ms ); + /* Read AUX parameters from config file */ + fla_test_read_aux_params ( AUX_PARAMETERS_FILENAME, ¶ms ); + #if AOCL_FLA_SET_PROGRESS_ENABLE == 2 aocl_fla_set_progress(test_progress); #endif /* Test the LAPACK-level operations. */ fla_test_lapack_suite( OPERATIONS_FILENAME, ¶ms ); + + if( LINEAR_PARAMETERS_FILENAME ) + free( LINEAR_PARAMETERS_FILENAME ); + if( SYM_EIG_PARAMETERS_FILENAME ) + free( SYM_EIG_PARAMETERS_FILENAME ); + if( SVD_PARAMETERS_FILENAME ) + free( SVD_PARAMETERS_FILENAME ); + if( NON_SYM_EIG_PARAMETERS_FILENAME ) + free( NON_SYM_EIG_PARAMETERS_FILENAME ); + if( AUX_PARAMETERS_FILENAME ) + free( AUX_PARAMETERS_FILENAME ); + } + else + { + return 0; } return 0; } +/* Function for checking cmd option or config file directory */ +int fla_check_cmd_config_dir( int argc, char** argv ) +{ + integer i, j, len_lin_file, len_eig_file, len_svd_file, len_eig_nsy_file, len_aux_file; + int cmd_test_option = 0; + char *config_dir = NULL; + char *lin_file; + char *eig_file; + char *svd_file; + char *eig_nsy_file; + char *aux_file; + char *config_opt = "--config-dir="; + integer len_config_opt = strlen(config_opt); + + struct stat info; + bool dir = 0; + + /*for default config*/ + if(argc == 1) + { + lin_file = "config/short/LIN_SLVR.dat"; + eig_file = "config/short/EIG_PARAMS.dat"; + svd_file = "config/short/SVD.dat"; + eig_nsy_file = "config/short/EIG_NSYM_PARAMS.dat"; + aux_file = "config/short/AUX_PARAMS.dat"; + + len_lin_file = strlen( lin_file); + len_eig_file = strlen( eig_file); + len_svd_file = strlen( svd_file); + len_eig_nsy_file = strlen( eig_nsy_file); + len_aux_file = strlen( aux_file); + + LINEAR_PARAMETERS_FILENAME = (char *) malloc(len_lin_file + 1 ); + SYM_EIG_PARAMETERS_FILENAME = (char *) malloc(len_eig_file + 1); + SVD_PARAMETERS_FILENAME = (char *) malloc(len_svd_file + 1 ); + NON_SYM_EIG_PARAMETERS_FILENAME = (char *) malloc(len_eig_nsy_file + 1); + AUX_PARAMETERS_FILENAME = (char *) malloc(len_aux_file + 1 ); + + memcpy( LINEAR_PARAMETERS_FILENAME, lin_file, len_lin_file + 1 ); + + memcpy( SYM_EIG_PARAMETERS_FILENAME, eig_file, len_eig_file + 1 ); + + memcpy( SVD_PARAMETERS_FILENAME, svd_file, len_svd_file + 1); + + memcpy( NON_SYM_EIG_PARAMETERS_FILENAME, eig_nsy_file, len_eig_nsy_file + 1 ); + + memcpy( AUX_PARAMETERS_FILENAME, aux_file, len_aux_file + 1); + + return 0; + } + else if(argc == 2 && strlen(argv[1]) > len_config_opt) + { + /*checking config dir option or cmd*/ + if(!(strncmp(argv[1], config_opt, len_config_opt ))) + { + config_dir = (char *) malloc( strlen( argv[1] + len_config_opt ) + 1); + memcpy( config_dir, argv[1] + len_config_opt, strlen( argv[1] + len_config_opt) + 1 ); + + char *c_str = "config/"; + lin_file = "/LIN_SLVR.dat"; + svd_file = "/SVD.dat"; + eig_file = "/EIG_PARAMS.dat"; + eig_nsy_file = "/EIG_NSYM_PARAMS.dat"; + aux_file = "/AUX_PARAMS.dat"; + + integer len_cstr = strlen( c_str); + integer len_dir = strlen( config_dir); + len_lin_file = strlen( lin_file); + len_eig_file = strlen( eig_file); + len_svd_file = strlen( svd_file); + len_eig_nsy_file = strlen( eig_nsy_file); + len_aux_file = strlen( aux_file); + + char *dir_path = (char *) malloc(len_cstr + len_dir + 1); + + /*checking given Directory exist or not*/ + memcpy(dir_path, c_str, len_cstr); + memcpy(dir_path + len_cstr, config_dir, len_dir + 1); + + if( stat( dir_path, &info ) != 0 ) + { + printf("Error: '%s' directory not found under 'config' directory. Exiting... \n", config_dir); + cmd_test_option = -1; + } + else if( info.st_mode & S_IFDIR ) // S_ISDIR() doesn't exist on my windows + dir = 1; + else + { + printf("Error: '%s' directory not found under 'config' directory. Exiting... \n", config_dir); + cmd_test_option = -1; + } + + /*Reading the config directory*/ + if(dir) + { + LINEAR_PARAMETERS_FILENAME = (char *) malloc(len_cstr + len_dir + len_lin_file + 1); + SYM_EIG_PARAMETERS_FILENAME = (char *) malloc(len_cstr + len_dir + len_eig_file + 1); + SVD_PARAMETERS_FILENAME = (char *) malloc(len_cstr + len_dir + len_svd_file + 1); + NON_SYM_EIG_PARAMETERS_FILENAME = (char *) malloc(len_cstr + len_dir + len_eig_nsy_file + 1); + AUX_PARAMETERS_FILENAME = (char *) malloc(len_cstr + len_dir + len_aux_file + 1); + + memcpy(LINEAR_PARAMETERS_FILENAME, c_str, len_cstr); + memcpy(LINEAR_PARAMETERS_FILENAME + len_cstr, config_dir, len_dir); + memcpy(LINEAR_PARAMETERS_FILENAME + len_cstr + len_dir, lin_file, len_lin_file + 1); + + memcpy(SYM_EIG_PARAMETERS_FILENAME, c_str, len_cstr); + memcpy(SYM_EIG_PARAMETERS_FILENAME + len_cstr, config_dir, len_dir); + memcpy(SYM_EIG_PARAMETERS_FILENAME + len_cstr + len_dir, eig_file, len_eig_file + 1); + + memcpy(SVD_PARAMETERS_FILENAME, c_str, len_cstr); + memcpy(SVD_PARAMETERS_FILENAME + len_cstr, config_dir, len_dir); + memcpy(SVD_PARAMETERS_FILENAME + len_cstr + len_dir, svd_file, len_svd_file + 1); + + memcpy(NON_SYM_EIG_PARAMETERS_FILENAME, c_str, len_cstr); + memcpy(NON_SYM_EIG_PARAMETERS_FILENAME + len_cstr, config_dir, len_dir); + memcpy(NON_SYM_EIG_PARAMETERS_FILENAME + len_cstr + len_dir, eig_nsy_file, len_eig_nsy_file + 1); + + memcpy(AUX_PARAMETERS_FILENAME, c_str, len_cstr); + memcpy(AUX_PARAMETERS_FILENAME + len_cstr, config_dir, len_dir); + memcpy(AUX_PARAMETERS_FILENAME + len_cstr + len_dir, aux_file, len_aux_file + 1); + + cmd_test_option = 0; + } + if(dir_path) + free(dir_path); + } + else + { + cmd_test_option = 1; + } + } + else + { + /*cmd option*/ + cmd_test_option = 1; + } + if(config_dir) + free(config_dir); + + return cmd_test_option; +} /* This function reads the operation file to execute selected LAPACK APIs*/ void fla_test_lapack_suite( char* input_filename, test_params_t *params ) @@ -896,6 +1083,49 @@ void fla_test_read_sym_eig_params( const char *file_name , test_params_t* params CHECK_LINE_SKIP (); } + /* Range is used to select the range of eigen values to be generated */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%s", str); + params->eig_sym_paramslist[i].range_x = *str; + CHECK_LINE_SKIP(); + } + + /* Index of the smallest eigen value to be returned */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%"FT_IS"", &(params->eig_sym_paramslist[i].IL)); + CHECK_LINE_SKIP(); + } + + /* Index of the largest eigen value to be returned */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%"FT_IS"", &(params->eig_sym_paramslist[i].IU)); + CHECK_LINE_SKIP(); + } + + /* Lower bound of the interval to be searched for eigen values */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%f", &(params->eig_sym_paramslist[i].VL)); + CHECK_LINE_SKIP(); + } + + /* Upper bound of the interval to be searched for eigen values */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%f", &(params->eig_sym_paramslist[i].VU)); + CHECK_LINE_SKIP(); + } + + /* The absolute error tolerance for the eigen values */ + fscanf(fp, "%s", &line[0]); + for (i = 0; i < NUM_SUB_TESTS; i++) { + fscanf(fp, "%f", &(params->eig_sym_paramslist[i].abstol)); + CHECK_LINE_SKIP(); + } + fscanf(fp, "%s", &line[0]); for (i=0; ieig_sym_paramslist[i].threshold_value) ); @@ -1594,6 +1824,133 @@ void fla_test_read_svd_params ( const char *file_name, test_params_t* params ) fclose(fp); } +/* This function reads parameters needed for aux APIs + from the config settings file 'AUX_PARAMS.dat' and saves in the + 'params->aux_paramslist' structure array */ +void fla_test_read_aux_params ( const char *file_name, test_params_t* params ) +{ + FILE *fp; + integer i, j; + char line[25]; + char *str; + char eol; + integer num_tests; + integer ndata_types; + integer num_ranges; + + str = &line[0]; + fp = fopen( file_name, "r"); + if (fp == NULL){ + printf("Error: aux config file missing. Exiting.. \n"); + exit(-1); + } + + fscanf(fp, "%s", &line[0]); + fscanf(fp, "%"FT_IS"", &num_tests); + for (i=0; iaux_paramslist[i].num_tests = num_tests; + } + + num_ranges = num_tests; + fscanf(fp, "%s", &line[0]); // Range_start + for (i=0; iaux_paramslist[i].m_range_start) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // Range_end + for (i=0; iaux_paramslist[i].m_range_end) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // Range_step_size + for (i=0; iaux_paramslist[i].m_range_step_size) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // Range_start + for (i=0; iaux_paramslist[i].n_range_start) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // Range_end + for (i=0; iaux_paramslist[i].n_range_end) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // Range_step_size + for (i=0; iaux_paramslist[i].n_range_step_size) ); + CHECK_LINE_SKIP (); + } + + for (i=0; iaux_paramslist[i].num_ranges = num_ranges; + } + + fscanf(fp, "%s", &line[0]); // leading dimension of input + for (i=0; iaux_paramslist[i].lda) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // The increment between successive values of CX + for (i=0; iaux_paramslist[i].incx) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // The increment between successive values of CY + for (i=0; iaux_paramslist[i].incy) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); // number of repeats + for (i=0; iaux_paramslist[i].num_repeats) ); + CHECK_LINE_SKIP (); + } + + ndata_types = NUM_SUB_TESTS; + fscanf(fp, "%s", &line[0]);// num data types + for( i = 0; i < NUM_SUB_TESTS; i++ ) + { + fscanf(fp, "%s", str); // num data types + for( j = 0; j < NUM_SUB_TESTS; j++ ) + { + params->aux_paramslist[j].data_types_char[i] = *str; + params->aux_paramslist[j].data_types[i] = get_datatype(*str); + } + eol = fgetc(fp); + if((eol == '\r') || (eol == '\n')){ + ndata_types = ( (i+1) < ndata_types)? (i+1):ndata_types; + break; + } + } + + for (i=0; iaux_paramslist[i].num_data_types = ndata_types; + } + + fscanf(fp, "%s", &line[0]); + for (i=0; iaux_paramslist[i].matrix_layout) ); + CHECK_LINE_SKIP (); + } + + fscanf(fp, "%s", &line[0]); + for (i=0; iaux_paramslist[i].aux_threshold) ); + CHECK_LINE_SKIP (); + } + + fclose(fp); +} void fla_test_output_info( char* message, ... ) { @@ -1750,29 +2107,25 @@ char* fla_test_get_string_for_result( double residual, integer datatype, double if ( datatype == FLOAT ) { - if ( residual == DBL_MAX ) r_val = fla_test_incomplete_string; - else if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; + if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; else if ( residual > thresh ) r_val = fla_test_fail_string; else r_val = fla_test_pass_string; } else if ( datatype == DOUBLE ) { - if ( residual == DBL_MAX ) r_val = fla_test_incomplete_string; - else if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; + if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; else if ( residual > thresh ) r_val = fla_test_fail_string; else r_val = fla_test_pass_string; } else if ( datatype == COMPLEX ) { - if ( residual == DBL_MAX ) r_val = fla_test_incomplete_string; - else if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; + if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; else if ( residual > thresh ) r_val = fla_test_fail_string; else r_val = fla_test_pass_string; } else { - if ( residual == DBL_MAX ) r_val = fla_test_incomplete_string; - else if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; + if ( residual == DBL_MIN ) r_val = fla_test_invalid_string; else if ( residual > thresh ) r_val = fla_test_fail_string; else r_val = fla_test_pass_string; } @@ -1786,8 +2139,7 @@ void fla_test_init_strings( void ) sprintf( fla_test_pass_string, "PASS" ); sprintf( fla_test_warn_string, "MARGINAL" ); sprintf( fla_test_fail_string, "FAIL" ); - sprintf( fla_test_incomplete_string, "INCOMPLETE" ); - sprintf( fla_test_invalid_string, "INVALID_LDA" ); + sprintf( fla_test_invalid_string, "INVALID_PARAM" ); sprintf( fla_test_storage_format_string, "Row(r) and General(g) storage format is not supported by External LAPACK interface" ); sprintf( fla_test_stor_chars, STORAGE_SCHEME_CHARS ); } @@ -1803,6 +2155,7 @@ void fla_test_op_driver( char* func_str, integer, // q_cur integer, // pci (param combo counter) integer, // n_repeats + integer, // einfo double*, // perf double*, //time double* ) ) // residual @@ -1812,7 +2165,7 @@ void fla_test_op_driver( char* func_str, integer num_ranges, range_loop_counter; integer p_first, p_max, p_inc; integer q_first, q_max, q_inc; - integer dt, p_cur, q_cur; + integer dt, p_cur, q_cur, einfo = 0; char datatype_char; integer datatype; double thresh; @@ -1840,6 +2193,10 @@ void fla_test_op_driver( char* func_str, case SVD: num_ranges = params->svd_paramslist[0].num_ranges; break; + + case AUX: + num_ranges = params->aux_paramslist[0].num_ranges; + break; default: fla_test_output_error( "Invalid API type. Exiting...\n" ); @@ -1906,6 +2263,21 @@ void fla_test_op_driver( char* func_str, n_repeats = params->svd_paramslist[range_loop_counter].num_repeats; n_datatypes = params->svd_paramslist[range_loop_counter].num_data_types; break; + + case AUX: + p_first = params->aux_paramslist[range_loop_counter].m_range_start; + p_max = params->aux_paramslist[range_loop_counter].m_range_end; + p_inc = params->aux_paramslist[range_loop_counter].m_range_step_size; + q_first = params->aux_paramslist[range_loop_counter].n_range_start; + q_max = params->aux_paramslist[range_loop_counter].n_range_end; + q_inc = params->aux_paramslist[range_loop_counter].n_range_step_size; + thresh = params->aux_paramslist[range_loop_counter].aux_threshold; + params->datatype = params->aux_paramslist[range_loop_counter].data_types; + params->datatype_char = params->aux_paramslist[range_loop_counter].data_types_char; + n_repeats = params->aux_paramslist[range_loop_counter].num_repeats; + n_datatypes = params->aux_paramslist[range_loop_counter].num_data_types; + break; + default: return; } @@ -1925,7 +2297,7 @@ void fla_test_op_driver( char* func_str, #pragma omp for for ( ith = 0; ith < n_threads; ith++ ) { - f_exp(params, datatype, p_cur, q_cur, range_loop_counter, n_repeats, (perf+ith), (time+ith), (residual+ith)); + f_exp(params, datatype, p_cur, q_cur, range_loop_counter, n_repeats, einfo, (perf+ith), (time+ith), (residual+ith)); } get_max(DOUBLE, (void*)residual, (void*)&residual_max_val, n_threads); @@ -1936,7 +2308,7 @@ void fla_test_op_driver( char* func_str, } else { - f_exp(params, datatype, p_cur, q_cur, range_loop_counter, n_repeats, perf, time, residual); + f_exp(params, datatype, p_cur, q_cur, range_loop_counter, n_repeats, einfo, perf, time, residual); fla_test_print_status(func_str, datatype_char, sqr_inp, p_cur, q_cur, *residual, thresh, *time, *perf); } @@ -2070,22 +2442,22 @@ void fla_test_get_time_unit(char * scale , double * time) return ; } - if ((*time < 1) && (*time > 0.001)) + if ((*time < 1) && (*time >= 0.001)) { scale[0]='m'; *time *= 1000; } - else if ((*time <0.001) && (*time > 0.000001)) + else if ((*time <0.001) && (*time >= 0.000001)) { scale[0]='u'; *time *= 1000000; } - else if ((*time < 0.000001) && (*time > 0.000000001)) + else if ((*time < 0.000001) && (*time >= 0.000000001)) { scale[0]='n'; *time *= 1000000000; } - else if ((*time < 0.000000001) && (*time > 0.000000000001)) + else if ((*time < 0.000000001) && (*time >= 0.000000000001)) { scale[0]='p'; *time *= 1000000000000; diff --git a/test/main/src/test_lapack.h b/test/main/src/test_lapack.h index b7a9c3f10..31300b71c 100644 --- a/test/main/src/test_lapack.h +++ b/test/main/src/test_lapack.h @@ -8,6 +8,8 @@ #include #include #include +#include +#include #ifdef _WIN32 #include #endif @@ -22,10 +24,6 @@ #include "test_common.h" #define OPERATIONS_FILENAME "input.global.operations" -#define LINEAR_PARAMETERS_FILENAME "config/LIN_SLVR.dat" -#define SYM_EIG_PARAMETERS_FILENAME "config/EIG_PARAMS.dat" -#define SVD_PARAMETERS_FILENAME "config/SVD.dat" -#define NON_SYM_EIG_PARAMETERS_FILENAME "config/EIG_NSYM_PARAMS.dat" #define COMMENT_CHAR '#' #define MAX_BINARY_NAME_LENGTH 256 @@ -70,6 +68,8 @@ #define EIG_SYM (2) #define EIG_NSYM (3) #define SVD (4) +#define AUX (5) + //pass 1 to test standard AOCL_FLA_PROGRESS fucntion, //pass 2 to test register callback function @@ -79,6 +79,66 @@ int test_progress(const char* const api,const integer lenapi,const integer* const progress,const integer* const current_thread,const integer* const total_threads); #endif +/* Flag to indicate lwork/liwork/lrwork availability status + * <= 0 - To be calculated + * > 0 - Use the value + * */ +extern integer g_lwork; +extern integer g_liwork; +extern integer g_lrwork; +/* Variable to indicate the source of inputs + * = 0 - Inputs are from command line + * = 1 - Inputs are from config file + * */ +extern integer config_data; +/* File pointer for external file which is used + * to pass the input matrix values + * */ +extern FILE* g_ext_fptr; + + +#define FLA_TEST_PARSE_LAST_ARG(argv) \ + integer i; \ + char *info; \ + char info_value[2][MAX_PASS_STRING_LENGTH]; \ + \ + i = 0; \ + if(strstr(argv,"--einfo") != NULL) \ + { \ + info = strtok(argv,"="); \ + while( info != NULL && i < 2 ) \ + { \ + strcpy( info_value[i], info); \ + i++; \ + info = strtok(NULL, "="); \ + } \ + einfo = atoi(info_value[1]); \ + } \ + else if(strstr(argv,"--imatrix") != NULL) \ + { \ + info = strtok(argv,"="); \ + while( info != NULL && i < 2 ) \ + { \ + strcpy( info_value[i], info); \ + i++; \ + info = strtok(NULL, "="); \ + } \ + params->imatrix_char = info_value[1][0]; \ + } \ + else \ + { \ + g_ext_fptr = fopen(argv, "r"); \ + if (g_ext_fptr == NULL) \ + { \ + printf("\n Invalid input file argument \n"); \ + return; \ + } \ + } \ + +#define FLA_TEST_CHECK_EINFO(residual, info, einfo) \ + if(info != einfo) \ + *residual = DBL_MAX; \ + typedef struct Lin_solver_paramlist_t { integer num_ranges; // number of ranges to run @@ -172,6 +232,12 @@ typedef struct EIG_paramlist_t integer tsize; integer ilo; integer ihi; + char range_x; // range must be 'A', 'V' or 'I' + integer IL; + integer IU; + real VL; + real VU; + real abstol; integer threshold_value; // threshold value for EIG }EIG_paramlist; @@ -305,6 +371,30 @@ typedef struct SVD_paramlist_t }SVD_paramlist; +/* struct to hold AUX parameters */ +typedef struct AUX_paramlist_t +{ + integer num_ranges; // number of ranges to run + integer m_range_start; + integer m_range_end; + integer m_range_step_size; + integer n_range_start; + integer n_range_end; + integer n_range_step_size; + integer lda; // Leading dimension of Array A. LDA >= fla_max(1, n) + integer incx; // The increment between successive values of CX + integer incy; // The increment between successive values of CY + integer num_repeats; + integer num_tests; + integer num_data_types; + integer data_types[MAX_NUM_DATATYPES]; + char data_types_char[MAX_NUM_DATATYPES]; + integer matrix_layout; // storage layout LAPACK_ROW_MAJOR or LAPACK_COL_MAJOR + /* Thresholds for the APIs */ + float aux_threshold; // threshold for the aux API + +}AUX_paramlist; + typedef struct { @@ -316,11 +406,13 @@ typedef struct integer p_max; integer p_inc; integer p_nfact; + char imatrix_char; struct SVD_paramlist_t svd_paramslist[NUM_SUB_TESTS]; struct EIG_Non_symmetric_paramlist_t eig_non_sym_paramslist[NUM_SUB_TESTS]; struct EIG_paramlist_t eig_sym_paramslist[NUM_SUB_TESTS]; struct Lin_solver_paramlist_t lin_solver_paramslist[NUM_SUB_TESTS]; + struct AUX_paramlist_t aux_paramslist[NUM_SUB_TESTS]; } test_params_t; @@ -338,7 +430,7 @@ typedef struct typedef struct { - integer type;/* 0 for LIN, 1 for EIG, 2 for SVD */ + integer type;/* 0 for LIN, 1 for EIG, 2 for SVD, 3 for AUX */ char *ops; void (*fp)(integer argc, char** argv, test_params_t *); }OPERATIONS; @@ -368,6 +460,9 @@ void fla_test_read_non_sym_eig_params( const char* input_filename, test_params_t /*Function to read SVD parametes from config file */ void fla_test_read_svd_params ( const char* input_filename, test_params_t* params ); +/*Function to read AUX parametes from config file */ +void fla_test_read_aux_params ( const char* input_filename, test_params_t* params ); + void fla_test_lapack_suite( char* input_filename, test_params_t *params ); void fla_test_op_driver( char* func_str, @@ -380,6 +475,7 @@ void fla_test_op_driver( char* func_str, integer, // q_cur integer, // pci (param combo counter) integer, // n_repeats + integer, // einfo double*, // perf double*, // time double* ) ); // residual diff --git a/test/main/src/test_lartg.c b/test/main/src/test_lartg.c new file mode 100644 index 000000000..a0f665abb --- /dev/null +++ b/test/main/src/test_lartg.c @@ -0,0 +1,244 @@ +/* + Copyright (C) 2022, Advanced Micro Devices, Inc. All rights reserved. +*/ + +#include "test_lapack.h" + +/* Local prototypes */ +void fla_test_lartg_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, + integer n_repeats, integer einfo, double* perf, double* t, double* residual); +void prepare_lartg_run(integer datatype, void *f, void *g, void *r, void *c, void *s, +integer n_repeats, double* time_min_); +void invoke_lartg(integer datatype, void *f, void *g, void *c, void *s, void *r); + +void fla_test_lartg(integer argc, char ** argv, test_params_t *params) +{ + char* op_str = "Auxilary routines"; + char* front_str = "LARTG"; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; + integer i, num_types; + integer datatype, n_repeats; + double perf, time_min, residual; + char stype, type_flag[4] = {0}; + char *endptr; + + if(argc == 1) + { + fla_test_output_info("--- %s ---\n", op_str); + fla_test_output_info("\n"); + num_types = params->aux_paramslist[0].num_data_types; + n_repeats = params->aux_paramslist[0].num_repeats; + + if (n_repeats > 0) + { + /* Loop over the requested datatypes. */ + for ( i = 0; i < num_types; ++i ) + { + datatype = params->datatype[i]; + stype = params->datatype_char[i]; + + /* Call the test code */ + fla_test_lartg_experiment(params, datatype, + 2, i_one, + 0, + n_repeats, einfo, + &perf, &time_min, &residual); + /* Print the results */ + fla_test_print_status(front_str, + stype, + RECT_INPUT, + 2, i_one, + residual, params->aux_paramslist[0].aux_threshold, + time_min, perf); + tests_not_run = 0; + } + } + } + if (argc == 5) + { + FLA_TEST_PARSE_LAST_ARG(argv[4]); + } + + if (argc >= 4 && argc <= 5) + { + /* Test with parameters from commandline */ + /* Parse the arguments */ + num_types = strlen(argv[2]); + + n_repeats = strtoimax(argv[3], &endptr, CLI_DECIMAL_BASE); + + if(n_repeats > 0) + { + params->aux_paramslist[0].aux_threshold = CLI_NORM_THRESH; + + for(i = 0; i < num_types; i++) + { + stype = argv[2][i]; + datatype = get_datatype(stype); + + /* Check for invalide dataype */ + if(datatype == INVALID_TYPE) + { + invalid_dtype = 1; + continue; + } + + /* Check for duplicate datatype presence */ + if(type_flag[datatype - FLOAT] == 1) + continue; + type_flag[datatype - FLOAT] = 1; + + /* Call the test code */ + fla_test_lartg_experiment(params, datatype, + 2, i_one, + 0, + n_repeats, einfo, + &perf, &time_min, &residual); + /* Print the results */ + fla_test_print_status(front_str, + stype, + RECT_INPUT, + 2, i_one, + residual, params->aux_paramslist[0].aux_threshold, + time_min, perf); + tests_not_run = 0; + } + } + } + + /* Print error messages */ + if(tests_not_run) + { + printf("\n Illegal arguments for lartg \n"); + printf("./ lartg [file] \n"); + } + if(invalid_dtype) + { + printf("\nInvalid datatypes specified, choose valid datatypes from 'sdcz'\n\n"); + } + if (g_ext_fptr != NULL) + { + fclose(g_ext_fptr); + g_ext_fptr = NULL; + } + + return; +} + +void fla_test_lartg_experiment(test_params_t *params, + integer datatype, + integer p_cur, + integer q_cur, + integer pci, + integer n_repeats, + integer einfo, + double* perf, + double* t, + double* residual) +{ + void *s = NULL, *c = NULL; + void *f = NULL, *g = NULL, *r = NULL; + double time_min = 1e9; + + integer realtype; + realtype = get_realtype(datatype); + + *residual = params->aux_paramslist[pci].aux_threshold; + + create_vector(realtype, &c, 1); + create_vector(datatype, &s, 1); + + create_vector(datatype, &f, 1); + create_vector(datatype, &g, 1); + create_vector(datatype, &r, 1); + + if(g_ext_fptr != NULL) + { + init_vector_from_file(datatype, f, 1, 1, g_ext_fptr); + init_vector_from_file(datatype, g, 1, 1, g_ext_fptr); + } + else + { + rand_vector(datatype, f, 1, 1); + rand_vector(datatype, g, 1, 1); + } + /* call to API */ + prepare_lartg_run(datatype, f, g, r, c, s, n_repeats, &time_min); + + /* execution time */ + *t = time_min; + if(time_min == d_zero) + { + time_min = 1e-9; + *t = time_min; + } + /* Compute the performance of the best experiment repeat */ + *perf = (double)(6.0) / time_min / FLOPS_PER_UNIT_PERF; + + /* output validation */ + validate_lartg(datatype, f, g, r, c, s, residual); + + /* Free up the buffers */ + free_vector(c); + free_vector(s); + free_vector(f); + free_vector(g); + free_vector(r); +} + +void prepare_lartg_run(integer datatype, + void *f, + void *g, + void *r, + void *c, + void *s, + integer n_repeats, + double* time_min_) +{ + integer i; + double time_min = 1e9, exe_time; + + for (i = 0; i < n_repeats; ++i) + { + exe_time = fla_test_clock(); + + /* call lartg API */ + invoke_lartg(datatype, f, g, c, s, r); + + exe_time = fla_test_clock() - exe_time; + + /* Get the best execution time */ + time_min = fla_min(time_min, exe_time); + } + + *time_min_ = time_min; +} + +void invoke_lartg(integer datatype, void *f, void *g, void *c, void *s, void *r) +{ + switch(datatype) + { + case FLOAT: + { + fla_lapack_slartg(f, g, (float *) c, (float *)s, r); + break; + } + + case DOUBLE: + { + fla_lapack_dlartg(f, g, (double *) c, (double *)s, r); + break; + } + case COMPLEX: + { + fla_lapack_clartg(f, g, (float *) c, ((scomplex *)s), r); + break; + } + + case DOUBLE_COMPLEX: + { + fla_lapack_zlartg(f, g, (double *) c, ((dcomplex *)s), r); + break; + } + } +} \ No newline at end of file diff --git a/test/main/src/test_org2r.c b/test/main/src/test_org2r.c new file mode 100644 index 000000000..2b25974d4 --- /dev/null +++ b/test/main/src/test_org2r.c @@ -0,0 +1,300 @@ +/* + Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*/ + +#include "test_lapack.h" +#include "test_common.h" +#include "test_prototype.h" + +/* Local prototypes.*/ +void fla_test_org2r_experiment(test_params_t *params, integer datatype, + integer p_cur, integer q_cur, integer pci, + integer n_repeats, integer einfo, double* perf, + double* t,double* residual); +void prepare_org2r_run(integer m, integer n, void *A, integer lda, void *T, + void* work, integer datatype, integer n_repeats, + double* time_min_, integer *info); +void invoke_org2r(integer datatype, integer* m, integer* n, integer *min_A, + void* a, integer* lda, void* tau, void* work, integer* info); + +void fla_test_org2r(integer argc, char ** argv, test_params_t *params) +{ + char* op_str = "QR factorization"; + char* front_str = "ORG2R"; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; + + if(argc == 1) + { + g_lwork = -1; + config_data = 1; + fla_test_output_info("--- %s ---\n", op_str); + fla_test_output_info("\n"); + fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_org2r_experiment); + tests_not_run = 0; + } + if (argc == 8) + { + FLA_TEST_PARSE_LAST_ARG(argv[7]); + } + if (argc >= 7 && argc <= 8) + { + integer i, num_types,N,M; + integer datatype, n_repeats; + double perf, time_min, residual; + char stype,type_flag[4] = {0}; + char *endptr; + + /* Parse the arguments */ + num_types = strlen(argv[2]); + M = strtoimax(argv[3], &endptr, CLI_DECIMAL_BASE); + N = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); + params->lin_solver_paramslist[0].lda = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + g_lwork = -1; + + n_repeats = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); + + if(n_repeats > 0) + { + params->lin_solver_paramslist[0].solver_threshold = CLI_NORM_THRESH; + + for(i = 0; i < num_types; i++) + { + stype = argv[2][i]; + datatype = get_datatype(stype); + + /* Check for invalide dataype */ + if(datatype == INVALID_TYPE) + { + invalid_dtype = 1; + continue; + } + + /* Check for duplicate datatype presence */ + if(type_flag[datatype - FLOAT] == 1) + continue; + type_flag[datatype - FLOAT] = 1; + + /* Call the test code */ + fla_test_org2r_experiment(params, datatype, + M, N, + 0, + n_repeats, einfo, + &perf, &time_min, &residual); + /* Print the results */ + fla_test_print_status(front_str, + stype, + RECT_INPUT, + M, N, + residual, params->lin_solver_paramslist[0].solver_threshold, + time_min, perf); + tests_not_run = 0; + } + } + } + + /* Print error messages */ + if(tests_not_run) + { + printf("\nIllegal arguments for org2r\n"); + printf("./ org2r \n"); + } + if(invalid_dtype) + { + printf("\nInvalid datatypes specified, choose valid datatypes from 'sdcz'\n\n"); + } + if (g_ext_fptr != NULL) + { + fclose(g_ext_fptr); + g_ext_fptr = NULL; + } + return; +} + +void fla_test_org2r_experiment(test_params_t *params, + integer datatype, + integer p_cur, + integer q_cur, + integer pci, + integer n_repeats, + integer einfo, + double* perf, + double* time_min, + double* residual) +{ + integer m, n, lda; + void *A = NULL, *A_test = NULL, *T_test = NULL; + void *work = NULL, *work_test = NULL; + void *Q = NULL, *R = NULL; + integer lwork = -1, info = 0, vinfo = 0; + + /* Get input matrix dimensions.*/ + m = p_cur; + n = q_cur; + lda = params->lin_solver_paramslist[pci].lda; + *time_min = 0.; + *perf = 0.; + *residual = params->lin_solver_paramslist[pci].solver_threshold; + + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (lda == -1) + { + lda = fla_max(1,m); + } + } + + if(m >= n) + { + /* Create input matrix parameters */ + create_matrix(datatype, &A, lda, n); + + /* create tau vector */ + create_vector(datatype, &T_test, fla_min(m,n)); + + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); + + /* Make a copy of input matrix A. + This is required to validate the API functionality.*/ + create_matrix(datatype, &A_test, lda, n); + copy_matrix(datatype, "full", m, n, A, lda, A_test, lda); + + /* create Q matrix to check orthogonality */ + create_matrix(datatype, &Q, lda, n); + reset_matrix(datatype, m, n, Q, lda); + + /* Make a workspace query the first time. This will provide us with + and ideal workspace size based on internal block size.*/ + if(g_lwork <= 0) + { + lwork = -1; + create_vector(datatype, &work, 1); + + /* call to geqrf API */ + invoke_geqrf(datatype, &m, &n, NULL, &lda, NULL, work, &lwork, &info); + + if(info == 0) + { + /* Get work size */ + lwork = get_work_value(datatype, work); + } + + /* Output buffers will be freshly allocated for each iterations, free up + the current output buffers.*/ + free_vector(work); + } + + /* create work buffer */ + create_matrix(datatype, &work, lwork, 1); + create_vector(datatype, &work_test, n); + + /* QR Factorisation on matrix A to generate Q and R */ + invoke_geqrf(datatype, &m, &n, A_test, &lda, T_test, work, &lwork, &info); + + create_matrix(datatype, &R, n, n); + reset_matrix(datatype, n, n, R, n); + copy_matrix(datatype, "Upper", n, n, A_test, lda, R, n); + + copy_matrix(datatype, "full", m, n, A_test, lda, Q, lda); + + /*invoke org2r API */ + prepare_org2r_run(m, n, Q, lda, T_test, work_test, datatype, n_repeats, time_min, &info); + + /* performance computation + (2/3)*n2*(3m - n) */ + *perf = (double)((2.0 * m * n * n) - (( 2.0 / 3.0 ) * n * n * n )) / *time_min / FLOPS_PER_UNIT_PERF; + if(datatype == COMPLEX || datatype == DOUBLE_COMPLEX) + *perf *= 4.0; + + /* output validation */ + if(info == 0) + validate_orgqr(m, n, A, lda, Q, R, work_test, datatype, residual, &vinfo); + + FLA_TEST_CHECK_EINFO(residual, info, einfo); + + /* Free up the buffers */ + free_matrix(A); + free_matrix(A_test); + free_matrix(work); + free_vector(work_test); + free_vector(T_test); + free_matrix(Q); + free_matrix(R); + } +} + +void prepare_org2r_run(integer m, integer n, + void* A, + integer lda, + void* T, + void* work, + integer datatype, + integer n_repeats, + double* time_min_, + integer *info) +{ + integer i; + void *A_save = NULL; + double time_min = 1e9, exe_time; + + /* Make a copy of the input matrix A. Same input values will be passed in + each itertaion.*/ + create_matrix(datatype, &A_save, lda, n); + copy_matrix(datatype, "full", m, n, A, lda, A_save, lda); + + *info = 0; + for (i = 0; i < n_repeats && *info == 0; ++i) + { + /* Restore input matrix A value and allocate memory to output buffers + for each iteration*/ + copy_matrix(datatype, "full", m, n, A_save, lda, A, lda); + + exe_time = fla_test_clock(); + + /* Call to org2r API */ + invoke_org2r(datatype, &m, &n, &n, A, &lda, T, work, info); + + exe_time = fla_test_clock() - exe_time; + + /* Get the best execution time */ + time_min = fla_min(time_min, exe_time); + + } + + *time_min_ = time_min; + + free_matrix(A_save); +} + + +void invoke_org2r(integer datatype, integer* m, integer* n, integer *min_A, + void* a, integer* lda, void* tau, void* work, integer* info) +{ + switch(datatype) + { + case FLOAT: + { + fla_lapack_sorg2r(m, n, n, a, lda, tau, work, info); + break; + } + + case DOUBLE: + { + fla_lapack_dorg2r(m, n, n, a, lda, tau, work, info); + break; + } + + case COMPLEX: + { + fla_lapack_cung2r(m, n, n, a, lda, tau, work, info); + break; + } + + case DOUBLE_COMPLEX: + { + fla_lapack_zung2r(m, n, n, a, lda, tau, work, info); + break; + } + } +} diff --git a/test/main/src/test_orgqr.c b/test/main/src/test_orgqr.c index bdd85614e..e22578a64 100644 --- a/test/main/src/test_orgqr.c +++ b/test/main/src/test_orgqr.c @@ -7,42 +7,30 @@ #include "test_prototype.h" /* Local prototypes.*/ -void fla_test_orgqr_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, double* perf, double* t,double* residual); +void fla_test_orgqr_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, integer einfo, double* perf, double* t,double* residual); void prepare_orgqr_run(integer m, integer n, void *A, integer lda, void *T, void* work, integer *lwork, integer datatype, integer n_repeats, double* time_min_, integer *info); void invoke_orgqr(integer datatype, integer* m, integer* n, integer *min_A, void* a, integer* lda, void* tau, void* work, integer* lwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_orgqr(integer argc, char ** argv, test_params_t *params) { char* op_str = "QR factorization"; char* front_str = "ORGQR"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, RECT_INPUT, params, LIN, fla_test_orgqr_experiment); tests_not_run = 0; } - if (argc == 8) + if (argc == 9) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[8]); } - if (argc >= 7 && argc <= 8) + if (argc >= 8 && argc <= 9) { integer i, num_types,N,M; integer datatype, n_repeats; @@ -54,10 +42,10 @@ void fla_test_orgqr(integer argc, char ** argv, test_params_t *params) num_types = strlen(argv[2]); M = strtoimax(argv[3], &endptr, CLI_DECIMAL_BASE); N = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); - params->lin_solver_paramslist[0].lda = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); - g_lwork = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + params->lin_solver_paramslist[0].lda = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + g_lwork = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); - n_repeats = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); + n_repeats = strtoimax(argv[7], &endptr, CLI_DECIMAL_BASE); if(n_repeats > 0) { @@ -84,7 +72,7 @@ void fla_test_orgqr(integer argc, char ** argv, test_params_t *params) fla_test_orgqr_experiment(params, datatype, M, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -111,6 +99,7 @@ void fla_test_orgqr(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -121,6 +110,7 @@ void fla_test_orgqr_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* time_min, double* residual) @@ -139,10 +129,14 @@ void fla_test_orgqr_experiment(test_params_t *params, *perf = 0.; *residual = params->lin_solver_paramslist[pci].solver_threshold; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } if(m >= n) @@ -153,16 +147,7 @@ void fla_test_orgqr_experiment(test_params_t *params, /* create tau vector */ create_vector(datatype, &T_test, fla_min(m,n)); - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - init_matrix_from_file(datatype, A, m, n, lda, g_ext_fptr); - } - else - { - /* Initialize input matrix with random numbers */ - rand_matrix(datatype, A, m, n, lda); - } + init_matrix(datatype, A, m, n, lda, g_ext_fptr, params->imatrix_char); /* Make a copy of input matrix A. This is required to validate the API functionality.*/ create_matrix(datatype, &A_test, lda, n); @@ -181,20 +166,13 @@ void fla_test_orgqr_experiment(test_params_t *params, /* call to geqrf API */ invoke_geqrf(datatype, &m, &n, NULL, &lda, NULL, work, &lwork, &info); - if(info < 0) + + if(info == 0) { - *residual = DBL_MAX; - free_matrix(A); - free_matrix(A_test); - free_vector(T_test); - free_matrix(Q); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value(datatype, work); } - /* Get work size */ - lwork = get_work_value(datatype, work); - /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -210,30 +188,11 @@ void fla_test_orgqr_experiment(test_params_t *params, /* QR Factorisation on matrix A to generate Q and R */ invoke_geqrf(datatype, &m, &n, A_test, &lda, T_test, work, &lwork, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(A); - free_matrix(A_test); - free_vector(T_test); - free_matrix(Q); - free_vector(work); - free_vector(work_test); - return; - } - if(m == n) - { - create_matrix(datatype, &R, m, n); - reset_matrix(datatype, m, n, R, m); - copy_matrix(datatype, "Upper", m, n, A_test, lda, R, m); - } - else - { - create_matrix(datatype, &R, n, n); - reset_matrix(datatype, n, n, R, n); - copy_matrix(datatype, "Upper", n, n, A_test, lda, R, n); - } + create_matrix(datatype, &R, n, n); + reset_matrix(datatype, n, n, R, n); + copy_matrix(datatype, "Upper", n, n, A_test, lda, R, n); + copy_matrix(datatype, "full", m, n, A_test, lda, Q, lda); /*invoke orgqr API */ @@ -249,9 +208,7 @@ void fla_test_orgqr_experiment(test_params_t *params, if(info == 0) validate_orgqr(m, n, A, lda, Q, R, work_test, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(A); @@ -284,6 +241,7 @@ void prepare_orgqr_run(integer m, integer n, create_matrix(datatype, &A_save, lda, n); copy_matrix(datatype, "full", m, n, A, lda, A_save, lda); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_potrf.c b/test/main/src/test_potrf.c index 9957ba2c3..eff849eef 100644 --- a/test/main/src/test_potrf.c +++ b/test/main/src/test_potrf.c @@ -7,17 +7,17 @@ #include "test_prototype.h" /* Local prototypes.*/ -void fla_test_potrf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats,double* perf, double* time_min, double* residual); +void fla_test_potrf_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, integer einfo, double* perf, double* time_min, double* residual); void prepare_potrf_run(char* uplo, integer m, void *A, integer lda, integer datatype, integer n_repeats, double* time_min_, integer *info); -static FILE* g_ext_fptr = NULL; void fla_test_potrf(integer argc, char ** argv, test_params_t *params) { char* op_str = "Cholesky factorization"; char* front_str = "POTRF"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_potrf_experiment); @@ -25,13 +25,7 @@ void fla_test_potrf(integer argc, char ** argv, test_params_t *params) } if (argc == 8) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[7]); } if (argc >= 7 && argc <= 8) { @@ -74,7 +68,7 @@ void fla_test_potrf(integer argc, char ** argv, test_params_t *params) fla_test_potrf_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -101,6 +95,7 @@ void fla_test_potrf(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -111,6 +106,7 @@ void fla_test_potrf_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* time_min, double* residual) @@ -119,15 +115,20 @@ void fla_test_potrf_experiment(test_params_t *params, integer info = 0, vinfo = 0; void *A = NULL, *A_test = NULL; char uplo = params->lin_solver_paramslist[pci].Uplo; + *residual = params->lin_solver_paramslist[pci].solver_threshold; /* Get input matrix dimensions */ m = p_cur; lda = params->lin_solver_paramslist[pci].lda; - if(lda < m) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,m); + } } /* Create input matrix parameters */ @@ -159,9 +160,7 @@ void fla_test_potrf_experiment(test_params_t *params, if(info == 0) validate_potrf(&uplo, m, A, A_test, lda, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); free_matrix(A); free_matrix(A_test); @@ -184,6 +183,7 @@ void prepare_potrf_run(char* uplo, integer m, create_matrix(datatype, &A_save, lda, m); copy_matrix(datatype, "full", m, m, A, lda, A_save, lda); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_potrs.c b/test/main/src/test_potrs.c index 354ac165b..bd85130fc 100644 --- a/test/main/src/test_potrs.c +++ b/test/main/src/test_potrs.c @@ -5,19 +5,19 @@ #include "test_lapack.h" // Local prototypes. -void fla_test_potrs_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats,double* perf, double* time_min,double* residual); +void fla_test_potrs_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, integer n_repeats, integer einfo, double* perf, double* time_min,double* residual); void prepare_potrs_run(char* uplo, integer m, integer nrhs, void *A, integer lda, integer datatype, void *b, integer ldb, integer n_repeats, double* time_min_, integer *info); void invoke_potrs(char* uplo, integer datatype, integer* m, void* A, integer* lda, integer *nrhs, void* b, integer* ldb, integer* info); -static FILE* g_ext_fptr = NULL; void fla_test_potrs(integer argc, char ** argv, test_params_t *params) { char* op_str = "Cholesky factorization"; char* front_str = "POTRS"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, LIN, fla_test_potrs_experiment); @@ -25,13 +25,7 @@ void fla_test_potrs(integer argc, char ** argv, test_params_t *params) } if (argc == 10) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[9]); } if (argc >= 9 && argc <= 10) { @@ -77,7 +71,7 @@ void fla_test_potrs(integer argc, char ** argv, test_params_t *params) fla_test_potrs_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -104,6 +98,7 @@ void fla_test_potrs(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -115,6 +110,7 @@ void fla_test_potrs_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -132,10 +128,18 @@ void fla_test_potrs_experiment(test_params_t *params, lda = params->lin_solver_paramslist[pci].lda; ldb = params->lin_solver_paramslist[pci].ldb; - if(lda < n || ldb < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } + if (ldb == -1) + { + ldb = fla_max(1,n); + } } /* Create input matrix parameters */ @@ -162,16 +166,7 @@ void fla_test_potrs_experiment(test_params_t *params, copy_matrix(datatype, "full", n, n, A, lda, A_test, lda); /* cholesky factorisation of A as input to potrs */ invoke_potrf(&uplo, datatype, &n, A, &lda, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(A); - free_matrix(A_test); - free_matrix(B_test); - free_matrix(B); - free_matrix(X); - return; - } + copy_matrix(datatype, "full", n, nrhs, B, ldb, B_test, ldb); /* Invoke potrs API to find x using Ax-b */ @@ -189,10 +184,8 @@ void fla_test_potrs_experiment(test_params_t *params, if(info == 0) validate_potrs(n, nrhs, A_test, lda, X, B, ldb, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; - + FLA_TEST_CHECK_EINFO(residual, info, einfo); + free_matrix(A); free_matrix(A_test); free_matrix(B_test); @@ -222,6 +215,7 @@ void prepare_potrs_run(char* uplo, create_matrix(datatype, &A_save, lda, n); create_matrix(datatype, &B_test, ldb, nrhs); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_rot.c b/test/main/src/test_rot.c new file mode 100644 index 000000000..d97826424 --- /dev/null +++ b/test/main/src/test_rot.c @@ -0,0 +1,278 @@ +/* + Copyright (C) 2022, Advanced Micro Devices, Inc. All rights reserved. +*/ + +#include "test_lapack.h" + +/* Local prototypes */ +void fla_test_rot_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, + integer n_repeats, integer einfo, double* perf, double* t, double* residual); +void prepare_rot_run(integer datatype, integer n_A, void* cx, integer incx, void* cy, integer incy, void *c, void *s, +integer n_repeats, double* time_min_); +void invoke_rot(integer datatype, integer *n, void *cx, integer *incx, void *cy,integer *incy, void *c, void *s); +extern void invoke_lartg(integer datatype, void *f, void *g, void *c, void *s, void *r); + +void fla_test_rot(integer argc, char ** argv, test_params_t *params) +{ + char* op_str = "Auxilary routines"; + char* front_str = "ROT"; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; + + if(argc == 1) + { + fla_test_output_info("--- %s ---\n", op_str); + fla_test_output_info("\n"); + fla_test_op_driver(front_str, SQUARE_INPUT, params, AUX, fla_test_rot_experiment); + tests_not_run = 0; + } + if (argc == 8) + { + FLA_TEST_PARSE_LAST_ARG(argv[7]); + } + + if (argc >= 7 && argc <= 8) + { + /* Test with parameters from commandline */ + integer i, num_types, N; + integer datatype, n_repeats; + double perf, time_min, residual; + char stype, type_flag[4] = {0}; + char *endptr; + + /* Parse the arguments */ + num_types = strlen(argv[2]); + N = strtoimax(argv[3], &endptr, CLI_DECIMAL_BASE); + params->aux_paramslist[0].incx = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); + params->aux_paramslist[0].incy = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + + n_repeats = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); + + if(n_repeats > 0) + { + params->aux_paramslist[0].aux_threshold = CLI_NORM_THRESH; + + for(i = 0; i < num_types; i++) + { + stype = argv[2][i]; + datatype = get_datatype(stype); + + /* Check for invalide dataype */ + if(datatype == INVALID_TYPE) + { + invalid_dtype = 1; + continue; + } + + /* Check for duplicate datatype presence */ + if(type_flag[datatype - FLOAT] == 1) + continue; + type_flag[datatype - FLOAT] = 1; + + /* Call the test code */ + fla_test_rot_experiment(params, datatype, + N, N, + 0, + n_repeats, einfo, + &perf, &time_min, &residual); + /* Print the results */ + fla_test_print_status(front_str, + stype, + SQUARE_INPUT, + N, N, + residual, params->aux_paramslist[0].aux_threshold, + time_min, perf); + tests_not_run = 0; + } + } + } + + /* Print error messages */ + if(tests_not_run) + { + printf("\nIllegal arguments for rot \n"); + printf("./ rot [file]\n"); + } + if(invalid_dtype) + { + printf("\nInvalid datatypes specified, choose valid datatypes from 'sdcz'\n\n"); + } + if (g_ext_fptr != NULL) + { + fclose(g_ext_fptr); + g_ext_fptr = NULL; + } + + return; +} + +void fla_test_rot_experiment(test_params_t *params, + integer datatype, + integer p_cur, + integer q_cur, + integer pci, + integer n_repeats, + integer einfo, + double* perf, + double* t, + double* residual) +{ + integer n, incx, incy; + void *cx = NULL, *cy = NULL, *s = NULL, *c = NULL;; + void *f = NULL, *g = NULL, *r = NULL; + void *cx_test = NULL, *cy_test = NULL; + double time_min = 1e9; + + integer realtype; + realtype = get_realtype(datatype); + + *residual = params->aux_paramslist[pci].aux_threshold; + incx = params->aux_paramslist[pci].incx; + incy = params->aux_paramslist[pci].incy; + /* Determine the dimensions*/ + n = p_cur ; + if (n <= 0) + { + *residual = DBL_MIN; + return; + } + + /* Create the vectors for the current operation*/ + create_vector(datatype, &cx, 1 + (n-1)*abs(incx)); + create_vector(datatype, &cy, 1 + (n-1)*abs(incy)); + + create_vector(datatype, &cx_test, 1 + (n-1)*abs(incx)); + create_vector(datatype, &cy_test, 1 + (n-1)*abs(incy)); + + create_vector(realtype, &c, 1); + create_vector(datatype, &s, 1); + + create_vector(datatype, &f, 1); + create_vector(datatype, &g, 1); + create_vector(datatype, &r, 1); + + rand_vector(datatype, f, 1, 1); + rand_vector(datatype, g, 1, 1); + + /*calling lartg api for getting c and s value for plane rotation*/ + invoke_lartg(datatype, f, g, c, s, r); + + if (g_ext_fptr != NULL) + { + /* Initialize input vectors with custom data */ + init_vector_from_file(datatype, cx, 1 + (n-1)*abs(incx), 1, g_ext_fptr); + init_vector_from_file(datatype, cy, 1 + (n-1)*abs(incy), 1, g_ext_fptr); + } + else + { + /* Initialize input matrix with random numbers */ + rand_vector(datatype, cx, 1 + (n-1)*abs(incx), 1); + rand_vector(datatype, cy, 1 + (n-1)*abs(incy), 1); + } + copy_vector(datatype, 1 + (n - 1)*abs(incx), cx, i_one, cx_test, i_one); + copy_vector(datatype, 1 + (n - 1)*abs(incy), cy, i_one, cy_test, i_one); + /* call to API */ + prepare_rot_run(datatype, n, cx, incx, cy, incy, c, s, n_repeats, &time_min); + + /* execution time */ + *t = time_min; + if(time_min == d_zero) + { + time_min = 1e-9; + *t = time_min; + } + /* Compute the performance of the best experiment repeat */ + /* 4*n */ + *perf = (double)(4.0 * n ) / time_min / FLOPS_PER_UNIT_PERF; + /* output validation */ + validate_rot(datatype, n, cx, cx_test, incx, cy, cy_test, incy, c, s, residual); + + /* Free up the buffers */ + free_vector(cx); + free_vector(cy); + free_vector(cx_test); + free_vector(cy_test); + free_vector(c); + free_vector(s); + free_vector(f); + free_vector(g); + free_vector(r); +} + + +void prepare_rot_run(integer datatype, + integer n_A, + void* cx, + integer incx, + void* cy, + integer incy, + void *c, + void *s, + integer n_repeats, + double* time_min_) +{ + integer i; + void *cx_save = NULL, *cy_save = NULL; + double time_min = 1e9, exe_time; + + create_vector(datatype, &cx_save, 1 + (n_A - 1)*abs(incx)); + create_vector(datatype, &cy_save, 1 + (n_A - 1)*abs(incy)); + + for (i = 0; i < n_repeats; ++i) + { + /* Copy original input data */ + copy_vector(datatype, 1 + (n_A - 1)*abs(incx), cx, i_one, cx_save, i_one); + copy_vector(datatype, 1 + (n_A - 1)*abs(incy), cy, i_one, cy_save, i_one); + + exe_time = fla_test_clock(); + + /* call rot API */ + invoke_rot(datatype, &n_A, cx_save, &incx, cy_save, &incy, c, s); + + exe_time = fla_test_clock() - exe_time; + + /* Get the best execution time */ + time_min = fla_min(time_min, exe_time); + } + + *time_min_ = time_min; + /* Save the final result to A matrix*/ + copy_vector(datatype, 1 + (n_A - 1)*abs(incx), cx_save, i_one, cx, i_one); + copy_vector(datatype, 1 + (n_A - 1)*abs(incy), cy_save, i_one, cy, i_one); + + free_vector(cx_save); + free_vector(cy_save); +} + + +/* + * rot_API calls LAPACK interface + * */ +void invoke_rot(integer datatype, integer *n, void *cx, integer *incx, void *cy,integer *incy, void *c, void *s) +{ + switch(datatype) + { + case FLOAT: + { + fla_lapack_srot(n, cx, incx, cy, incy,((float *)c), ((float *)s)); + break; + } + + case DOUBLE: + { + fla_lapack_drot(n, cx, incx, cy, incy,((double *)c), ((double *)s)); + break; + } + case COMPLEX: + { + fla_lapack_crot(n, cx, incx, cy, incy,((float *)c), ((scomplex *)s)); + break; + } + + case DOUBLE_COMPLEX: + { + fla_lapack_zrot(n, cx, incx, cy, incy,((double *)c), ((dcomplex *)s)); + break; + } + } +} + diff --git a/test/main/src/test_routines.h b/test/main/src/test_routines.h index ef7c1e17d..45c2b712c 100644 --- a/test/main/src/test_routines.h +++ b/test/main/src/test_routines.h @@ -32,10 +32,15 @@ void fla_test_spffrtx(integer argc, char ** argv, test_params_t* params); void fla_test_gehrd(integer argc, char ** argv, test_params_t *params); void fla_test_hgeqz(integer argc, char ** argv, test_params_t *params); void fla_test_gghrd(integer argc, char ** argv, test_params_t* params); +void fla_test_rot(integer argc, char ** argv, test_params_t* params); +void fla_test_lartg(integer argc, char ** argv, test_params_t* params); +void fla_test_org2r(integer argc, char ** argv, test_params_t* params); +void fla_test_syevx(integer argc, char ** argv, test_params_t *params); #define LIN_ID 0 #define EIG_ID 1 #define SVD_ID 2 +#define AUX_ID 3 /* Add test api function call entry below */ OPERATIONS API_test_functions[] = @@ -68,7 +73,11 @@ OPERATIONS API_test_functions[] = {LIN_ID, "spffrtx" , fla_test_spffrtx}, {LIN_ID, "gehrd" , fla_test_gehrd}, {LIN_ID, "gghrd" , fla_test_gghrd}, - {EIG_ID, "hgeqz" , fla_test_hgeqz} + {EIG_ID, "hgeqz" , fla_test_hgeqz}, + {AUX_ID, "rot" , fla_test_rot}, + {AUX_ID, "lartg" , fla_test_lartg}, + {LIN_ID, "org2r" , fla_test_org2r}, + {EIG_ID, "syevx" , fla_test_syevx} }; /* Add test API's group entry below */ @@ -76,5 +85,6 @@ char *API_test_group[] = { "LIN", "EIG", - "SVD" + "SVD", + "AUX" }; diff --git a/test/main/src/test_spffrt2.c b/test/main/src/test_spffrt2.c index 050a4d1bf..95e055dce 100644 --- a/test/main/src/test_spffrt2.c +++ b/test/main/src/test_spffrt2.c @@ -6,16 +6,15 @@ /* Local prototypes */ void fla_test_spffrt2_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_spffrt2_run(integer n_A, integer ncolm, integer pn, void *A, integer datatype, integer n_repeats, double* time_min_); void invoke_spffrt2(integer datatype, void *a, integer* n, integer * ncolm, void *work, void *work2); -static FILE* g_ext_fptr = NULL; void fla_test_spffrt2(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computes LDLT partial factorization"; char* front_str = "SPFFRT2"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { @@ -26,13 +25,7 @@ void fla_test_spffrt2(integer argc, char ** argv, test_params_t *params) } if (argc == 7) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[6], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[6]); } if (argc >= 6 && argc <= 7) { @@ -75,7 +68,7 @@ void fla_test_spffrt2(integer argc, char ** argv, test_params_t *params) fla_test_spffrt2_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -102,6 +95,7 @@ void fla_test_spffrt2(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -114,6 +108,7 @@ void fla_test_spffrt2_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -161,10 +156,6 @@ void fla_test_spffrt2_experiment(test_params_t *params, { validate_spffrt2(n, ncolm, A, AP, datatype, residual); } - else - { /* Assigning bigger value to residual as execution fails */ - *residual = DBL_MAX; - } /* Free up the buffers */ free_matrix(A); diff --git a/test/main/src/test_spffrtx.c b/test/main/src/test_spffrtx.c index 3f3d37950..4731a22ed 100644 --- a/test/main/src/test_spffrtx.c +++ b/test/main/src/test_spffrtx.c @@ -6,16 +6,15 @@ /* Local prototypes */ void fla_test_spffrtx_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_spffrtx_run(integer n_A, integer ncolm, integer pn, void *A, integer datatype, integer n_repeats, double* time_min_); void invoke_spffrtx(integer datatype, void *a, integer* n, integer * ncolm, void *work, void *work2); -static FILE* g_ext_fptr = NULL; void fla_test_spffrtx(integer argc, char ** argv, test_params_t *params) { char* op_str = "Computes LDLT partial factorization"; char* front_str = "SPFFRTX"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { @@ -26,13 +25,7 @@ void fla_test_spffrtx(integer argc, char ** argv, test_params_t *params) } if (argc == 7) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[6], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[6]); } if (argc >= 6 && argc <= 7) { @@ -75,7 +68,7 @@ void fla_test_spffrtx(integer argc, char ** argv, test_params_t *params) fla_test_spffrtx_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -102,6 +95,7 @@ void fla_test_spffrtx(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; @@ -114,6 +108,7 @@ void fla_test_spffrtx_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -161,10 +156,6 @@ void fla_test_spffrtx_experiment(test_params_t *params, { validate_spffrtx(n, ncolm, A, AP, datatype, residual); } - else - { /* Assigning bigger value to residual as execution fails */ - *residual = DBL_MAX; - } /* Free up the buffers */ free_matrix(A); diff --git a/test/main/src/test_stedc.c b/test/main/src/test_stedc.c index 28e36c5cb..bea39b446 100644 --- a/test/main/src/test_stedc.c +++ b/test/main/src/test_stedc.c @@ -6,33 +6,25 @@ /* Local prototypes. */ void fla_test_stedc_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_stedc_run(char* compz, integer n, void* D, void* E, void* Z, integer ldz, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_stedc(integer datatype, char* compz, integer* n, void* D, void* E, void* Z, integer* ldz, void* work, integer* lwork, void* rwork, integer* lrwork, integer* iwork, integer* liwork, integer *info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static integer g_liwork; -static integer g_lrwork; -static FILE* g_ext_fptr = NULL; - void fla_test_stedc(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigenvalues/eigenvectors of symmetric tridiagonal matrix"; char* front_str = "STEDC"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; g_liwork = -1; g_lrwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_stedc_experiment); @@ -40,13 +32,7 @@ void fla_test_stedc(integer argc, char ** argv, test_params_t *params) } if(argc == 11) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[10], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[10]); } if(argc >= 10 && argc <= 11) { @@ -93,7 +79,7 @@ void fla_test_stedc(integer argc, char ** argv, test_params_t *params) fla_test_stedc_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -120,6 +106,7 @@ void fla_test_stedc(integer argc, char ** argv, test_params_t *params) if(g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -130,6 +117,7 @@ void fla_test_stedc_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double* t, double* residual) @@ -146,11 +134,16 @@ void fla_test_stedc_experiment(test_params_t *params, /* Initialize parameter needed for STEDC() call. */ compz = params->eig_sym_paramslist[pci].compz; lda = params->eig_sym_paramslist[pci].lda; + *residual = params->eig_sym_paramslist[pci].threshold_value; - if(lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } } create_matrix(datatype, &A, lda, n); @@ -158,43 +151,43 @@ void fla_test_stedc_experiment(test_params_t *params, realtype = get_realtype(datatype); create_vector(realtype, &D, n); create_vector(realtype, &E, n-1); - - if (g_ext_fptr != NULL) - { - /* Initialize input matrix with custom data */ - if (compz == 'V') - { - init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); - } - else - { - init_vector_from_file(datatype, D, n, 1, g_ext_fptr); - init_vector_from_file(datatype, E, n, 1, g_ext_fptr); - copy_sym_tridiag_matrix(datatype, D, E, n, n, A, lda); - } + if (g_ext_fptr != NULL) + { + /* Initialize input matrix with custom data */ + + if (compz == 'V') + { + init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); } else { - /* Create random symmetric/hermitian matrix if compz = V. */ - if (compz == 'V') + init_vector_from_file(datatype, D, n, 1, g_ext_fptr); + init_vector_from_file(datatype, E, n, 1, g_ext_fptr); + copy_sym_tridiag_matrix(datatype, D, E, n, n, A, lda); + } + } + else + { + /* Create random symmetric/hermitian matrix if compz = V. */ + if (compz == 'V') + { + if ((datatype == FLOAT) || (datatype == DOUBLE)) { - if ((datatype == FLOAT) || (datatype == DOUBLE)) - { - rand_sym_matrix(datatype, A, n, n, lda); - } - else - { - rand_hermitian_matrix(datatype, n, &A, lda); - } + rand_sym_matrix(datatype, A, n, n, lda); } else - { /* Create tridiagonal matrix using random Diagonal, subdiagonal elements if compz != V. */ - rand_vector(realtype, D, n, 1); - rand_vector(realtype, E, n - 1, 1); - copy_sym_tridiag_matrix(datatype, D, E, n, n, A, lda); + { + rand_hermitian_matrix(datatype, n, &A, lda); } - } + } + else + { /* Create tridiagonal matrix using random Diagonal, subdiagonal elements if compz != V. */ + rand_vector(realtype, D, n, 1); + rand_vector(realtype, E, n - 1, 1); + copy_sym_tridiag_matrix(datatype, D, E, n, n, A, lda); + } + } ldz = lda; create_matrix(datatype, &Z_input, ldz, n); @@ -207,14 +200,6 @@ void fla_test_stedc_experiment(test_params_t *params, /* Call SYTRD() orthogonal matrix and tridiagonal elements. invoke_sytrd() internally calls ORGTR() to get orthogonal matrix.*/ invoke_sytrd(datatype, &uplo, compz, n, A, lda, D, E, &info); - if (info != 0) { - free_matrix(A); - free_vector(D); - free_vector(E); - free_matrix(Z_input); - *residual = DBL_MAX; - return; - } } /* Make a copy of input matrices. This is required to validate the API functionality. */ create_matrix(datatype, &Z_test, ldz, n); @@ -243,14 +228,10 @@ void fla_test_stedc_experiment(test_params_t *params, } /* Output validation. */ - if (compz != 'N' && info == 0) + if (info == 0) validate_stedc(compz, n, D_test, Z_input, Z_test, ldz, datatype, residual, &vinfo); - else - *residual = 0.0; - /* Assigning bigger value to residual as execution fails */ - if(info < 0 || vinfo < 0) - *residual = DBL_MAX; + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up buffers. */ free_matrix(Z_input); @@ -301,17 +282,11 @@ void prepare_stedc_run(char* compz, integer n, void* D, void* E, void* Z, lwork = get_work_value(datatype, work ); liwork = get_work_value(INTEGER, iwork ); lrwork = get_work_value(realtype, rwork ); - free_vector(work); - free_vector(rwork); - free_vector(iwork); - } - else - { - free_vector(work); - free_vector(rwork); - free_vector(iwork); - return; } + + free_vector(work); + free_vector(rwork); + free_vector(iwork); } else { @@ -326,6 +301,7 @@ void prepare_stedc_run(char* compz, integer n, void* D, void* E, void* Z, create_vector(INTEGER, &iwork, liwork); create_vector(realtype, &E_test, n-1); + *info = 0; for (index = 0; index < n_repeats && *info == 0; ++index) { /* Restore input matrices and allocate memory to output buffers diff --git a/test/main/src/test_steqr.c b/test/main/src/test_steqr.c index e2f766d29..90f217cce 100644 --- a/test/main/src/test_steqr.c +++ b/test/main/src/test_steqr.c @@ -8,19 +8,19 @@ /* Local prototypes.*/ void fla_test_steqr_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, -integer n_repeats, double* perf, double* t, double* residual); +integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_steqr_run(char* compz, integer n, void* Z, integer ldz, void* D, void* E, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_steqr(integer datatype, char* compz, integer* n, void* z, integer* ldz, void* d, void* e, void* work, integer* info); -static FILE* g_ext_fptr = NULL; void fla_test_steqr(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Decomposition of symmetrix tridiagonal matrix"; char* front_str = "STEQR"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { + config_data = 1; /* Test with parameters from config */ fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); @@ -29,13 +29,7 @@ void fla_test_steqr(integer argc, char ** argv, test_params_t *params) } if (argc == 8) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[7], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[7]); } if (argc >= 7 && argc <= 8) { @@ -50,7 +44,7 @@ void fla_test_steqr(integer argc, char ** argv, test_params_t *params) num_types = strlen(argv[2]); params->eig_sym_paramslist[0].compz = argv[3][0]; N = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); - params->eig_sym_paramslist[0].lda = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + params->eig_sym_paramslist[0].ldz = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); n_repeats = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); if(n_repeats > 0) @@ -79,7 +73,7 @@ void fla_test_steqr(integer argc, char ** argv, test_params_t *params) fla_test_steqr_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -106,6 +100,7 @@ void fla_test_steqr(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -116,6 +111,7 @@ void fla_test_steqr_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -132,13 +128,17 @@ void fla_test_steqr_experiment(test_params_t *params, n = p_cur; ldz = params->eig_sym_paramslist[pci].ldz; - lda = ldz; - if(ldz < n || lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (ldz == -1) + { + ldz = fla_max(1,n); + } } + lda = ldz; /* Create input matrix parameters */ create_matrix(datatype, &Z, ldz, n); @@ -176,17 +176,7 @@ void fla_test_steqr_experiment(test_params_t *params, reset_matrix(datatype, n, n, Z_test, ldz); invoke_sytrd(datatype, &uplo, compz, n, Q, lda, D, E, &info); - if(info < 0) - { - *residual = DBL_MAX; - free_matrix(Z_test); - free_matrix(A); - free_matrix(Z); - free_matrix(Q); - free_vector(D); - free_vector(E); - return; - } + /*form tridiagonal matrix Z by copying from matrix*/ copy_sym_tridiag_matrix(datatype, D, E, n, n, Z, ldz); @@ -219,9 +209,8 @@ void fla_test_steqr_experiment(test_params_t *params, /* output validation */ if (info == 0) validate_syevd(&compz, n, Z, Z_test, ldz, D_test, datatype, residual, &vinfo); - - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(Z); @@ -259,6 +248,7 @@ void prepare_steqr_run(char *compz, copy_vector(get_realtype(datatype), n, D, 1, D_save, 1); copy_vector(get_realtype(datatype), n-1, E, 1, E_save, 1); + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_stevd.c b/test/main/src/test_stevd.c index a06240e0e..daa94c4ec 100644 --- a/test/main/src/test_stevd.c +++ b/test/main/src/test_stevd.c @@ -8,28 +8,21 @@ /* Local prototypes.*/ void fla_test_stevd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, -integer n_repeats, double* perf, double* t, double* residual); +integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_stevd_run(char* jobz, integer n, void* Z, integer ldz, void* D, void* E, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_stevd(integer datatype, char* jobz, integer* n, void* z, integer* ldz, void* d, void* e, void* work, integer* lwork, void* iwork, integer* liwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static integer g_liwork; -static FILE* g_ext_fptr = NULL; - void fla_test_stevd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Decomposition of symmetrix tridiagonal matrix"; char* front_str = "STEVD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; g_liwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_stevd_experiment); @@ -37,13 +30,7 @@ void fla_test_stevd(integer argc, char ** argv, test_params_t *params) } if(argc == 10) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[9], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[9]); } if(argc >= 9 && argc <= 10) { @@ -58,7 +45,7 @@ void fla_test_stevd(integer argc, char ** argv, test_params_t *params) num_types = strlen(argv[2]); params->eig_sym_paramslist[0].jobz = argv[3][0]; N = strtoimax(argv[4], &endptr, CLI_DECIMAL_BASE); - params->eig_sym_paramslist[0].lda = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); + params->eig_sym_paramslist[0].ldz = strtoimax(argv[5], &endptr, CLI_DECIMAL_BASE); g_lwork = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); g_liwork = strtoimax(argv[7], &endptr, CLI_DECIMAL_BASE); @@ -89,7 +76,7 @@ void fla_test_stevd(integer argc, char ** argv, test_params_t *params) fla_test_stevd_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -116,6 +103,7 @@ void fla_test_stevd(integer argc, char ** argv, test_params_t *params) if(g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -126,6 +114,7 @@ void fla_test_stevd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -145,10 +134,14 @@ void fla_test_stevd_experiment(test_params_t *params, if(datatype == FLOAT || datatype == DOUBLE) { n = p_cur; - if(ldz < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (ldz == -1) + { + ldz = fla_max(1,n); + } } /* Create input matrix parameters */ @@ -192,10 +185,8 @@ void fla_test_stevd_experiment(test_params_t *params, /* output validation */ if (info == 0) validate_syevd(&jobz, n, Z, Z_test, ldz, D_test, datatype, residual, &vinfo); - - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; + + FLA_TEST_CHECK_EINFO(residual, info, einfo); /* Free up the buffers */ free_matrix(Z); @@ -243,19 +234,13 @@ void prepare_stevd_run(char *jobz, create_vector(datatype, &work, 1); /* call to stevd API */ invoke_stevd(datatype, jobz, &n, NULL, &ldz, NULL, NULL, work, &lwork, iwork, &liwork, info); - if(*info < 0) + if(*info == 0) { - free_matrix(Z_save); - free_vector(D_save); - free_vector(E_save); - free_vector(iwork); - free_vector(work); - return; + /* Get work size */ + lwork = get_work_value(datatype, work ); + liwork = get_work_value(INTEGER, iwork ); } - /* Get work size */ - lwork = get_work_value(datatype, work ); - liwork = get_work_value(INTEGER, iwork ); /* Output buffers will be freshly allocated for each iterations, free up the current output buffers.*/ free_vector(work); @@ -267,6 +252,7 @@ void prepare_stevd_run(char *jobz, liwork = g_liwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_syev.c b/test/main/src/test_syev.c index 7f89f811c..588cb5515 100644 --- a/test/main/src/test_syev.c +++ b/test/main/src/test_syev.c @@ -8,28 +8,22 @@ /* Local prototypes.*/ void fla_test_syev_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, - integer n_repeats, double* perf, double* t, double* residual); + integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_syev_run(char* jobz, char* uplo, integer n, void* A, integer lda, void* w, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_syev(integer datatype, char* jobz, char* uplo, integer* n, void* a, integer* lda, void* w, void* work, integer* lwork, void *rwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static FILE* g_ext_fptr = NULL; - void fla_test_syev(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Values and Vectors"; char* front_str = "SYEV"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_syev_experiment); @@ -37,13 +31,7 @@ void fla_test_syev(integer argc, char ** argv, test_params_t *params) } if (argc == 10) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[9], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[9]); } if (argc >= 9 && argc <= 10) { @@ -87,7 +75,7 @@ void fla_test_syev(integer argc, char ** argv, test_params_t *params) fla_test_syev_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -114,6 +102,7 @@ void fla_test_syev(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } } @@ -123,6 +112,7 @@ void fla_test_syev_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -139,10 +129,14 @@ void fla_test_syev_experiment(test_params_t *params, n = p_cur; lda = params->eig_sym_paramslist[pci].lda; - if(lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } } /* Create input matrix parameters */ @@ -181,10 +175,8 @@ void fla_test_syev_experiment(test_params_t *params, if (info == 0) validate_syevd(&jobz, n, A, A_test, lda, w, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; - + FLA_TEST_CHECK_EINFO(residual, info, einfo); + /* Free up the buffers */ free_matrix(A); free_matrix(A_test); @@ -224,20 +216,16 @@ void prepare_syev_run(char *jobz, if(*info == 0) { lwork = get_work_value(datatype, work); - free_vector(work); - } - else - { - free_vector(work); - free_matrix(A_save); - return; } + + free_vector(work); } else { lwork = g_lwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_syevd.c b/test/main/src/test_syevd.c index 2b746b764..77639d2e3 100644 --- a/test/main/src/test_syevd.c +++ b/test/main/src/test_syevd.c @@ -8,30 +8,22 @@ /* Local prototypes.*/ void fla_test_syevd_experiment(test_params_t *params, integer datatype, integer p_cur, integer q_cur, integer pci, -integer n_repeats, double* perf, double* t, double* residual); +integer n_repeats, integer einfo, double* perf, double* t, double* residual); void prepare_syevd_run(char* jobz, char* uplo, integer n, void* A, integer lda, void* w, integer datatype, integer n_repeats, double* time_min_, integer* info); void invoke_syevd(integer datatype, char* jobz, char* uplo, integer* n, void* a, integer* lda, void* w, void* work, integer* lwork, void* rwork, integer* lrwork, void* iwork, integer* liwork, integer* info); -/* Flag to indicate lwork availability status - * <= 0 - To be calculated - * > 0 - Use the value - * */ -static integer g_lwork; -static integer g_liwork; -static integer g_lrwork; -static FILE* g_ext_fptr = NULL; - void fla_test_syevd(integer argc, char ** argv, test_params_t *params) { char* op_str = "Eigen Decomposition"; char* front_str = "SYEVD"; - integer tests_not_run = 1, invalid_dtype = 0; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; if(argc == 1) { g_lwork = -1; g_liwork = -1; g_lrwork = -1; + config_data = 1; fla_test_output_info("--- %s ---\n", op_str); fla_test_output_info("\n"); fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_syevd_experiment); @@ -39,13 +31,7 @@ void fla_test_syevd(integer argc, char ** argv, test_params_t *params) } if (argc == 12) { - /* Read matrix input data from a file */ - g_ext_fptr = fopen(argv[11], "r"); - if (g_ext_fptr == NULL) - { - printf("\n Invalid input file argument \n"); - return; - } + FLA_TEST_PARSE_LAST_ARG(argv[11]); } if (argc >= 11 && argc <= 12) { @@ -93,7 +79,7 @@ void fla_test_syevd(integer argc, char ** argv, test_params_t *params) fla_test_syevd_experiment(params, datatype, N, N, 0, - n_repeats, + n_repeats, einfo, &perf, &time_min, &residual); /* Print the results */ fla_test_print_status(front_str, @@ -120,6 +106,7 @@ void fla_test_syevd(integer argc, char ** argv, test_params_t *params) if (g_ext_fptr != NULL) { fclose(g_ext_fptr); + g_ext_fptr = NULL; } return; } @@ -130,6 +117,7 @@ void fla_test_syevd_experiment(test_params_t *params, integer q_cur, integer pci, integer n_repeats, + integer einfo, double* perf, double *time_min, double* residual) @@ -146,10 +134,14 @@ void fla_test_syevd_experiment(test_params_t *params, n = p_cur; lda = params->eig_sym_paramslist[pci].lda; - if(lda < n) + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) { - *residual = DBL_MIN; - return; + if (lda == -1) + { + lda = fla_max(1,n); + } } /* Create input matrix parameters */ @@ -188,10 +180,8 @@ void fla_test_syevd_experiment(test_params_t *params, if (info == 0) validate_syevd(&jobz, n, A, A_test, lda, w, datatype, residual, &vinfo); - /* Assigning bigger value to residual as execution fails */ - if (info < 0 || vinfo < 0) - *residual = DBL_MAX; - + FLA_TEST_CHECK_EINFO(residual, info, einfo); + /* Free up the buffers */ free_matrix(A); free_matrix(A_test); @@ -240,18 +230,11 @@ void prepare_syevd_run(char *jobz, lwork = get_work_value(datatype, work); liwork = get_work_value(INTEGER, iwork); lrwork = get_work_value(datatype, rwork); - free_vector(work); - free_vector(iwork); - free_vector(rwork); - } - else - { - free_vector(work); - free_vector(iwork); - free_vector(rwork); - free_matrix(A_save); - return; } + + free_vector(work); + free_vector(iwork); + free_vector(rwork); } else { @@ -260,6 +243,7 @@ void prepare_syevd_run(char *jobz, lrwork = g_lrwork; } + *info = 0; for (i = 0; i < n_repeats && *info == 0; ++i) { /* Restore input matrix A value and allocate memory to output buffers diff --git a/test/main/src/test_syevx.c b/test/main/src/test_syevx.c new file mode 100644 index 000000000..fa5f97288 --- /dev/null +++ b/test/main/src/test_syevx.c @@ -0,0 +1,415 @@ +/* + Copyright (C) 2023, Advanced Micro Devices, Inc. All rights reserved. +*/ + +#include "test_lapack.h" +#include "test_common.h" +#include "test_prototype.h" + +/* Local prototypes.*/ +void fla_test_syevx_experiment(test_params_t *params, integer datatype, + integer p_cur, integer q_cur, integer pci, + integer n_repeats, integer einfo, double* perf, + double* t, double* residual); +void prepare_syevx_run(char* jobz, char* range, char* uplo, integer n, void* A, + integer lda, void *vl, void *vu, integer il, + integer iu, void *abstol, void* w, integer ldz, + integer datatype, integer n_repeats, + double* time_min_, integer* info); +void invoke_syevx(integer datatype, char* jobz, char* range, char* uplo, + integer* n, void* a, integer* lda, void* vl, void* vu, + integer* il, integer* iu, void* abstol, integer* m, void* w, + void* z, integer* ldz, void* work, integer* lwork, + void* rwork, void* iwork, void* ifail, integer* info); + +void fla_test_syevx(integer argc, char ** argv, test_params_t *params) +{ + char* op_str = "Eigen Values and Vectors in specified range"; + char* front_str = "SYEVX"; + integer tests_not_run = 1, invalid_dtype = 0, einfo = 0; + + if(argc == 1) + { + g_lwork = -1; + config_data = 1; + fla_test_output_info("--- %s ---\n", op_str); + fla_test_output_info("\n"); + fla_test_op_driver(front_str, SQUARE_INPUT, params, EIG_SYM, fla_test_syevx_experiment); + tests_not_run = 0; + } + if (argc == 17) + { + FLA_TEST_PARSE_LAST_ARG(argv[16]); + } + if (argc >= 16 && argc <= 17) + { + integer i, num_types,N; + integer datatype, n_repeats; + double perf, time_min, residual; + char stype,type_flag[4] = {0}; + char *endptr; + + /* Parse the arguments */ + num_types = strlen(argv[2]); + params->eig_sym_paramslist[0].jobz = argv[3][0]; + params->eig_sym_paramslist[0].range_x = argv[4][0]; + params->eig_sym_paramslist[0].uplo = argv[5][0]; + N = strtoimax(argv[6], &endptr, CLI_DECIMAL_BASE); + params->eig_sym_paramslist[0].lda = strtoimax(argv[7], &endptr, CLI_DECIMAL_BASE); + + params->eig_sym_paramslist[0].VL = atof(argv[8]); + params->eig_sym_paramslist[0].VU = atof(argv[9]); + + if (params->eig_sym_paramslist[0].range_x == 'I') + { + /* 1 <= IL <= IU <= N, if N > 0; + IL = 1 and IU = 0 if N = 0. */ + if (N == 0) + { + params->eig_sym_paramslist[0].IL = 1; + params->eig_sym_paramslist[0].IU = 0; + printf("\nIL = 1 and IU = 0 if N = 0\n"); + } + else + { + params->eig_sym_paramslist[0].IL = strtoimax(argv[10], &endptr, CLI_DECIMAL_BASE); + params->eig_sym_paramslist[0].IU = strtoimax(argv[11], &endptr, CLI_DECIMAL_BASE); + } + } + + params->eig_sym_paramslist[0].abstol = atof(argv[12]); + + params->eig_sym_paramslist[0].ldz = strtoimax(argv[13], &endptr, CLI_DECIMAL_BASE); + + g_lwork = strtoimax(argv[14], &endptr, CLI_DECIMAL_BASE); + + n_repeats = strtoimax(argv[15], &endptr, CLI_DECIMAL_BASE); + + if(n_repeats > 0) + { + params->eig_sym_paramslist[0].threshold_value = CLI_NORM_THRESH; + + for(i = 0; i < num_types; i++) + { + stype = argv[2][i]; + datatype = get_datatype(stype); + + /* Check for invalide dataype */ + if(datatype == INVALID_TYPE) + { + invalid_dtype = 1; + continue; + } + + /* Check for duplicate datatype presence */ + if(type_flag[datatype - FLOAT] == 1) + continue; + type_flag[datatype - FLOAT] = 1; + + /* Call the test code */ + fla_test_syevx_experiment(params, datatype, + N, N, + 0, + n_repeats, einfo, + &perf, &time_min, &residual); + /* Print the results */ + fla_test_print_status(front_str, + stype, + SQUARE_INPUT, + N, N, + residual, params->eig_sym_paramslist[0].threshold_value, + time_min, perf); + tests_not_run = 0; + } + } + } + + /* Print error messages */ + if(tests_not_run) + { + printf("\nIllegal arguments for syevx\n"); + printf("./ syevx \n"); + } + if(invalid_dtype) + { + printf("\nInvalid datatypes specified, choose valid datatypes from 'sdcz'\n\n"); + } + if (g_ext_fptr != NULL) + { + fclose(g_ext_fptr); + g_ext_fptr = NULL; + } + return; +} + +void fla_test_syevx_experiment(test_params_t *params, + integer datatype, + integer p_cur, + integer q_cur, + integer pci, + integer n_repeats, + integer einfo, + double* perf, + double *time_min, + double* residual) +{ + integer n, lda, ldz, il, iu, info = 0, vinfo = 0; + char jobz, uplo, range; + void *A = NULL, *w = NULL, *A_test = NULL; + void *vl, *vu, *abstol; + + /* Get input matrix dimensions.*/ + jobz = params->eig_sym_paramslist[pci].jobz; + uplo = params->eig_sym_paramslist[pci].uplo; + range = params->eig_sym_paramslist[pci].range_x; + *residual = params->eig_sym_paramslist[pci].threshold_value; + + n = p_cur; + lda = params->eig_sym_paramslist[pci].lda; + ldz = params->eig_sym_paramslist[pci].ldz; + + il = params->eig_sym_paramslist[pci].IL; + iu = params->eig_sym_paramslist[pci].IU; + + create_realtype_vector(datatype, &vl, 1); + create_realtype_vector(datatype, &vu, 1); + create_realtype_vector(datatype, &abstol, 1); + + if (datatype == FLOAT || datatype == COMPLEX) + { + *(real*)vl = params->eig_sym_paramslist[pci].VL; + *(real*)vu = params->eig_sym_paramslist[pci].VU; + *(real*)abstol = params->eig_sym_paramslist[pci].abstol; + + /* When abstol value is set to -1, assign default value. + NOTE: Eigenvalues will be computed most accurately + when ABSTOL is set to twice the underflow + threshold 2*SLAMCH('S') */ + if (*(real*)abstol == -1) + *(real*)abstol = 2 * slamch_("S"); + } + else + { + *(doublereal*)vl = params->eig_sym_paramslist[pci].VL; + *(doublereal*)vu = params->eig_sym_paramslist[pci].VU; + *(doublereal*)abstol = params->eig_sym_paramslist[pci].abstol; + + /* When abstol value is set to -1, assign default value. + NOTE: Eigenvalues will be computed most accurately + when ABSTOL is set to twice the underflow + threshold 2*DLAMCH('S') */ + if (*(doublereal*)abstol == -1) + *(doublereal*)abstol = 2 * dlamch_("S"); + } + + /* If leading dimensions = -1, set them to default value + when inputs are from config files */ + if (config_data) + { + if (lda == -1) + { + lda = fla_max(1,n); + } + /* LDZ >= 1; + if JOBZ = 'V', LDZ >= max(1,N) */ + if (ldz == -1) + { + if (jobz == 'V') + { + ldz = fla_max(1,n); + } + else + { + ldz = 1; + } + } + } + + /* Create input matrix parameters */ + create_matrix(datatype, &A, lda, n); + create_realtype_vector(datatype, &w, n); + if (g_ext_fptr != NULL) + { + /* Initialize input matrix with custom data */ + init_matrix_from_file(datatype, A, n, n, lda, g_ext_fptr); + } + else + { + /* input matrix A with random symmetric numbers + or complex hermitian matrix */ + if (datatype == FLOAT || datatype == DOUBLE) + rand_sym_matrix(datatype, A, n, n, lda); + else + rand_hermitian_matrix(datatype, n, &A, lda); + } + /* Make a copy of input matrix A. + This is required to validate the API functionality.*/ + create_matrix(datatype, &A_test, lda, n); + copy_matrix(datatype, "full", n, n, A, lda, A_test, lda); + + prepare_syevx_run(&jobz, &range, &uplo, n, A_test, lda, vl, vu, il, iu, + abstol, w, ldz, datatype, n_repeats, time_min, + &info); + + /* performance computation + (8/3)n^3 flops for eigen vectors + (4/3)n^3 flops for eigen values */ + if( jobz == 'V') + *perf = (double)((8.0 / 3.0) * n * n * n) / *time_min / FLOPS_PER_UNIT_PERF; + else + *perf = (double)((4.0 / 3.0) * n * n * n) / *time_min / FLOPS_PER_UNIT_PERF; + if(datatype == COMPLEX || datatype == DOUBLE_COMPLEX) + *perf *= 4.0; + + /* output validation */ + if (info == 0 && range == 'A') + validate_syevd(&jobz, n, A, A_test, lda, w, datatype, residual, &vinfo); + + FLA_TEST_CHECK_EINFO(residual, info, einfo); + + /* Free up the buffers */ + free_vector(vl); + free_vector(vu); + free_vector(abstol); + free_matrix(A); + free_matrix(A_test); + free_vector(w); +} + +void prepare_syevx_run(char* jobz, char* range, char* uplo, integer n, void* A, + integer lda, void* vl, void* vu, integer il, + integer iu, void* abstol, void* w, integer ldz, + integer datatype, integer n_repeats, + double* time_min_, integer* info) +{ + void *A_save = NULL, *work = NULL, *rwork = NULL; + void *w_test = NULL, *z__ = NULL; + integer i, m, lwork; + double time_min = 1e9, exe_time; + void *iwork = NULL, *ifail = NULL; + + if(*range == 'I') + m = iu - il + 1; + else + m = n; + + /* Make a copy of the input matrix A. + Same input values will be passed in eaach itertaion.*/ + create_matrix(datatype, &A_save, lda, n); + copy_matrix(datatype, "full", n, n, A, lda, A_save, lda); + create_vector(INTEGER, &iwork, 5*n); + create_vector(INTEGER, &ifail, n); + + if (datatype == COMPLEX || datatype == DOUBLE_COMPLEX ) + create_realtype_vector(datatype, &rwork, (7*n)); + else + rwork = NULL; + + /* Make a workspace query the first time through. This will provide us with + and ideal workspace size based on an internal block size.*/ + if(g_lwork <= 0) + { + lwork = -1; + create_vector(datatype, &work, 1); + /* call to syevx API */ + invoke_syevx(datatype, jobz, range, uplo, &n, NULL, &lda, vl, vu, + &il, &iu, abstol, &m, NULL, NULL, &ldz, work, &lwork, + rwork, iwork, ifail, info); + /* Get work size */ + if(*info == 0) + { + lwork = get_work_value(datatype, work); + } + free_vector(work); + } + else + { + lwork = g_lwork; + } + + *info = 0; + for (i = 0; i < n_repeats && *info == 0; ++i) + { + /* Restore input matrix A value and allocate memory to output buffers + for each iteration*/ + copy_matrix(datatype, "full", n, n, A_save, lda, A, lda); + + create_realtype_vector(datatype, &w_test, n); + create_vector(datatype, &work, lwork); + create_matrix(datatype, &z__, ldz, fla_max(1, m)); + + exe_time = fla_test_clock(); + + /* call to API */ + invoke_syevx(datatype, jobz, range, uplo, &n, A, &lda, vl, vu, &il, + &iu, abstol, &m, w_test, z__, &ldz, work, &lwork, rwork, + iwork, ifail, info); + + exe_time = fla_test_clock() - exe_time; + + /* Get the best execution time */ + time_min = fla_min(time_min, exe_time); + + /* Make a copy of the output buffers. + This is required to validate the API functionality.*/ + copy_realtype_vector(datatype, n, w_test, 1, w, 1); + + /* If JOBZ = 'V', the first M columns of Z contain the + orthonormal eigenvectors of the matrix A corresponding to + the selected eigenvalues. + Copy eigen vectors to A to validate API functionality */ + if(*jobz == 'V') + copy_matrix(datatype, "full", m, m, z__, ldz, A, lda); + + /* Free up the output buffers */ + free_vector(work); + free_vector(w_test); + free_matrix(z__); + } + + *time_min_ = time_min; + if (datatype == COMPLEX || datatype == DOUBLE_COMPLEX) + free_vector(rwork); + free_vector(iwork); + free_vector(ifail); + free_matrix(A_save); +} + +void invoke_syevx(integer datatype, char* jobz, char* range, char* uplo, + integer* n, void* a, integer* lda, void* vl, void* vu, + integer* il, integer* iu, void* abstol, integer* m, void* w, + void* z, integer* ldz, void* work, integer* lwork, + void* rwork, void* iwork, void* ifail, integer* info) +{ + switch(datatype) + { + case FLOAT: + { + fla_lapack_ssyevx(jobz, range, uplo, n, a, lda, vl, vu, il, iu, + abstol, m, w, z, ldz, work, lwork, iwork, ifail, + info); + break; + } + case DOUBLE: + { + fla_lapack_dsyevx(jobz, range, uplo, n, a, lda, vl, vu, il, iu, + abstol, m, w, z, ldz, work, lwork, iwork, ifail, + info); + break; + } + case COMPLEX: + { + fla_lapack_cheevx(jobz, range, uplo, n, a, lda, vl, vu, il, iu, + abstol, m, w, z, ldz, work, lwork, rwork, iwork, + ifail, info); + break; + } + case DOUBLE_COMPLEX: + { + fla_lapack_zheevx(jobz, range, uplo, n, a, lda, vl, vu, il, iu, + abstol, m, w, z, ldz, work, lwork, rwork, iwork, + ifail, info); + break; + } + } +} diff --git a/test/main/validate_src/CMakeLists.txt b/test/main/validate_src/CMakeLists.txt index d18e93c3e..8c2891e9e 100644 --- a/test/main/validate_src/CMakeLists.txt +++ b/test/main/validate_src/CMakeLists.txt @@ -31,5 +31,7 @@ ${CMAKE_CURRENT_SOURCE_DIR}/validate_spffrtx.c ${CMAKE_CURRENT_SOURCE_DIR}/validate_gehrd.c ${CMAKE_CURRENT_SOURCE_DIR}/validate_hgeqz.c ${CMAKE_CURRENT_SOURCE_DIR}/validate_gghrd.c +${CMAKE_CURRENT_SOURCE_DIR}/validate_rot.c +${CMAKE_CURRENT_SOURCE_DIR}/validate_lartg.c ) diff --git a/test/main/validate_src/test_common.c b/test/main/validate_src/test_common.c index ee960f4f8..41307f7ee 100644 --- a/test/main/validate_src/test_common.c +++ b/test/main/validate_src/test_common.c @@ -12,7 +12,7 @@ scomplex c_zero = {0,0}, c_one = {1,0}, c_n_one = {-1,0}; dcomplex z_zero = {0,0}, z_one = {1,0}, z_n_one = {-1,0}; /* Allocate dynamic memory. If FLA_MEM_UNALIGNED is set, unaligned memory is allocated */ -char* fla_mem_alloc(integer size) +char* fla_mem_alloc(size_t size) { char* buff = NULL; #ifdef FLA_MEM_UNALIGNED @@ -43,31 +43,31 @@ void create_vector(integer datatype, void **A, integer M) { case INTEGER: { - *A = (integer *)fla_mem_alloc(M * sizeof(integer)); + *A = (integer *)fla_mem_alloc(fla_max(1, M) * sizeof(integer)); break; } case FLOAT: { - *A = (float *)fla_mem_alloc(M * sizeof(float)); + *A = (float *)fla_mem_alloc(fla_max(1, M) * sizeof(float)); break; } case DOUBLE: { - *A = (double *)fla_mem_alloc(M * sizeof(double)); + *A = (double *)fla_mem_alloc(fla_max(1, M) * sizeof(double)); break; } case COMPLEX: { - *A = (scomplex *)fla_mem_alloc(M * sizeof(scomplex)); + *A = (scomplex *)fla_mem_alloc(fla_max(1, M) * sizeof(scomplex)); break; } case DOUBLE_COMPLEX: { - *A = (dcomplex *)fla_mem_alloc(M * sizeof(dcomplex)); + *A = (dcomplex *)fla_mem_alloc(fla_max(1, M) * sizeof(dcomplex)); break; } } @@ -81,9 +81,9 @@ void create_realtype_vector(integer datatype, void **A, integer M) *A = NULL; if(datatype == FLOAT || datatype == COMPLEX) - *A = (float *)fla_mem_alloc(M * sizeof(float)); + *A = (float *)fla_mem_alloc(fla_max(1, M) * sizeof(float)); else - *A = (double *)fla_mem_alloc(M * sizeof(double)); + *A = (double *)fla_mem_alloc(fla_max(1, M) * sizeof(double)); return; } @@ -262,31 +262,31 @@ void create_matrix(integer datatype, void **A, integer M, integer N) { case INTEGER: { - *A = (integer *)fla_mem_alloc(M * N * sizeof(integer)); + *A = (integer *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(integer)); break; } case FLOAT: { - *A = (float *)fla_mem_alloc(M * N * sizeof(float)); + *A = (float *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(float)); break; } case DOUBLE: { - *A = (double *)fla_mem_alloc(M * N * sizeof(double)); + *A = (double *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(double)); break; } case COMPLEX: { - *A = (scomplex *)fla_mem_alloc(M * N * sizeof(scomplex)); + *A = (scomplex *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(scomplex)); break; } case DOUBLE_COMPLEX: { - *A = (dcomplex *)fla_mem_alloc(M * N * sizeof(dcomplex)); + *A = (dcomplex *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(dcomplex)); break; } } @@ -300,9 +300,9 @@ void create_realtype_matrix(integer datatype, void **A, integer M, integer N) *A = NULL; if(datatype == FLOAT || datatype == COMPLEX) - *A = (float *)fla_mem_alloc(M * N * sizeof(float)); + *A = (float *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(float)); else - *A = (double *)fla_mem_alloc(M * N * sizeof(double)); + *A = (double *)fla_mem_alloc(fla_max(1, M) * fla_max(1, N) * sizeof(double)); return; } @@ -358,7 +358,8 @@ void free_matrix(void *A) void rand_matrix(integer datatype, void *A, integer M, integer N, integer LDA) { integer i, j; - + if (LDA < M) + return; switch( datatype ) { case FLOAT: @@ -416,7 +417,8 @@ void rand_matrix(integer datatype, void *A, integer M, integer N, integer LDA) void rand_sym_matrix(integer datatype, void *A, integer M, integer N, integer LDA) { integer i, j; - + if(LDA < M) + return; switch( datatype ) { case FLOAT: @@ -480,6 +482,9 @@ void rand_sym_matrix(integer datatype, void *A, integer M, integer N, integer LD /* Copy a matrix */ void copy_matrix(integer datatype, char *uplo, integer M, integer N, void *A, integer LDA, void *B, integer LDB) { + if ((LDA < M) || (LDB < M)) + return; + switch( datatype ) { case INTEGER: @@ -537,7 +542,8 @@ void copy_realtype_matrix(integer datatype, char *uplo, integer M, integer N, vo void reset_matrix(integer datatype, integer M, integer N, void *A, integer LDA) { integer i, j; - + if(LDA < M) + return; switch( datatype ) { case INTEGER: @@ -566,7 +572,7 @@ void reset_matrix(integer datatype, integer M, integer N, void *A, integer LDA) case COMPLEX: { - fla_lapack_dlaset("A", &M, &N, &c_zero, &c_zero, A, &LDA); + fla_lapack_claset("A", &M, &N, &c_zero, &c_zero, A, &LDA); break; } @@ -584,6 +590,8 @@ void reset_matrix(integer datatype, integer M, integer N, void *A, integer LDA) /* Set a matrix to identity */ void set_identity_matrix(integer datatype, integer M, integer N, void *A, integer LDA) { + if (LDA < M) + return; switch( datatype ) { @@ -702,7 +710,7 @@ void diagmv( integer datatype, integer m, integer n, void* x, integer incx, void integer n_elem; integer j; - if(m == 0 || n == 0) + if(m <= 0 || n <= 0) return; // Initialize with optimal values for column-major storage. @@ -844,6 +852,8 @@ void rand_spd_matrix(integer datatype, char *uplo, void **A, integer m,integer l void *buff_A = NULL, *buff_B = NULL; void *a_temp = NULL; char trans_A, trans_B; + if (lda < m) + return; create_matrix(datatype, &sample, lda, m); create_matrix(datatype, &buff_A, lda, m); @@ -956,6 +966,8 @@ void diagonalize_vector(integer datatype, void* s, void* sigma, integer m, integ void rand_hermitian_matrix(integer datatype, integer n, void** A, integer lda) { void *B = NULL; + if (lda < n) + return; create_matrix(datatype, &B, n, n); reset_matrix(datatype, n, n, B, n); @@ -1265,7 +1277,8 @@ integer get_realtype(integer datatype) void rand_sym_tridiag_matrix(integer datatype, void *A, integer M, integer N, integer LDA) { integer i, j; - + if(LDA < M) + return; reset_matrix(datatype, M, N, A, LDA); switch( datatype ) @@ -1426,7 +1439,8 @@ void get_subdiagonal(integer datatype, void *A, integer m, integer n, integer ld void copy_sym_tridiag_matrix(integer datatype, void *D, void *E, integer M, integer N, void *B, integer LDA) { integer i, j; - + if (LDA < M) + return; reset_matrix(datatype, M, N, B, LDA); switch( datatype ) @@ -1743,7 +1757,8 @@ void get_min(integer datatype, void *arr, void *min_val, integer n) void init_matrix_from_file(integer datatype, void* A, integer m, integer n, integer lda, FILE* fptr) { int i, j; - + if (lda < m) + return; switch (datatype) { case FLOAT: @@ -1876,6 +1891,8 @@ void init_vector_from_file(integer datatype, void* A, integer m, integer inc, FI /* Convert matrix according to ILO and IHI values */ void get_generic_triangular_matrix(integer datatype, integer N, void *A, integer LDA, integer ilo, integer ihi) { + if(LDA < N) + return; /* Intialize matrix with random values */ rand_matrix(datatype, A, N, N, LDA); integer i; @@ -1956,6 +1973,8 @@ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, vo void *A_save = NULL; void *tau = NULL, *work = NULL; integer lwork; + if((lda < n) || (ldz < n)) + return; create_matrix(datatype, &A_save, lda, n); create_vector(datatype, &tau, n-1); @@ -1978,11 +1997,6 @@ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, vo lwork = get_work_value(datatype, work); free_vector(work); } - else - { - free_vector(work); - break; - } } else { @@ -2019,11 +2033,6 @@ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, vo lwork = get_work_value(datatype, work); free_vector(work); } - else - { - free_vector(work); - break; - } } else { @@ -2061,11 +2070,6 @@ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, vo lwork = get_work_value(datatype, work); free_vector(work); } - else - { - free_vector(work); - break; - } } else { @@ -2102,11 +2106,6 @@ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, vo lwork = get_work_value(datatype, work); free_vector(work); } - else - { - free_vector(work); - break; - } } else { @@ -2302,7 +2301,8 @@ void get_orthogonal_matrix_from_QR(integer datatype, integer n, void *A, integer { void *tau = NULL, *work = NULL; integer lwork = -1; - + if ((lda < n) || (ldq < n)) + return; /* Intializing matrix for the call to GGHRD */ create_vector(datatype, &work, 1); create_vector(datatype, &tau, n); @@ -2436,7 +2436,7 @@ void print_matrix(char* desc, integer datatype, integer M, integer N, void* A, i { for( j = 0; j < N; j++ ) { - printf(" %f", ((float *)A)[i + j * lda]); + printf(" %e", ((float *)A)[i + j * lda]); } printf( "\n" ); } @@ -2448,7 +2448,7 @@ void print_matrix(char* desc, integer datatype, integer M, integer N, void* A, i { for( j = 0; j < N; j++ ) { - printf(" %f", ((double *)A)[i + j * lda]); + printf(" %e", ((double *)A)[i + j * lda]); } printf( "\n" ); } @@ -2460,7 +2460,7 @@ void print_matrix(char* desc, integer datatype, integer M, integer N, void* A, i { for( j = 0; j < N; j++ ) { - printf(" (%f + j %f)", ((scomplex *)A)[i + j * lda].real, ((scomplex *)A)[i + j * lda].imag); + printf(" (%e + j %e)", ((scomplex *)A)[i + j * lda].real, ((scomplex *)A)[i + j * lda].imag); } printf( "\n" ); } @@ -2472,7 +2472,7 @@ void print_matrix(char* desc, integer datatype, integer M, integer N, void* A, i { for( j = 0; j < N; j++ ) { - printf(" (%f + j %f)", ((dcomplex *)A)[i + j * lda].real, ((scomplex *)A)[i + j * lda].imag); + printf(" (%e + j %e)", ((dcomplex *)A)[i + j * lda].real, ((scomplex *)A)[i + j * lda].imag); } printf( "\n" ); } @@ -2571,4 +2571,179 @@ void get_triangular_matrix(char *uplo, integer datatype, integer m, integer n, v break; } } +} + +/*Test to Check order of Singular values of SVD (positive and non-decreasing)*/ +double svd_check_order(integer datatype, void *s, integer m, integer n, double residual) +{ + integer min_m_n, i; + min_m_n = fla_min(m, n); + double resid = 0.; + + switch (datatype) + { + case INTEGER : + { + for( i = 0; i < (min_m_n - 1 ); i++ ) + { + if((((int *) s) [i] < 0 ) || (((int *) s)[i] < ((int *) s)[i + 1])) + { + resid = residual * 2; + break; + } + } + if(((int *) s) [min_m_n -1] < 0 ) + resid = residual * 2; + break; + } + case FLOAT : + { + for( i = 0; i < (min_m_n - 1 ); i++ ) + { + if((((float *) s) [i] < 0.f ) || (((float *) s)[i] < ((float *) s)[i + 1])) + { + resid = residual * 2; + break; + } + } + if(((float *) s) [min_m_n -1] < 0.f ) + resid = residual * 2; + break; + } + case DOUBLE : + { + for( i = 0; i < (min_m_n - 1 ); i++ ) + { + if((((double *) s)[i] < 0. ) || (((double *) s)[i] < ((double *) s)[i + 1])) + { + resid = residual * 2; + break; + } + } + if(((double *) s) [min_m_n -1] < 0. ) + resid = residual * 2; + break; + } + case COMPLEX: + { + for( i = 0; i < (min_m_n - 1 ); i++ ) + { + if( (((float *) s) [i] < 0.f ) || ( ((float *) s)[i] < ((float *) s)[i + 1])) + { + resid = residual * 2; + break; + } + } + if(((float *) s) [min_m_n - 1] < 0.f ) + resid = residual * 2; + break; + } + case DOUBLE_COMPLEX: + { + for( i = 0; i < (min_m_n - 1 ); i++ ) + { + if( (((double *) s)[i] < 0. ) || (((double *) s)[i] < ((double *) s)[i + 1]) ) + { + resid = residual * 2; + break; + } + } + if(((double *) s) [min_m_n - 1] < 0. ) + resid = residual * 2; + break; + } + default: + break; + } + return resid; +} + +/* Intialize matrix with special values*/ +void init_matrix_spec_in(integer datatype, void *A, integer M, integer N, integer LDA, char type) +{ + integer i, j, realdatatype; + if (LDA < M) + return; + switch( datatype ) + { + case FLOAT: + { + float value; + if(type == 'I') + value = INFINITY; + else if(type == 'N') + value = NAN; + for( i = 0; i < N; i++ ) + { + for( j = 0; j < M; j++ ) + { + ((float *)A)[i * LDA + j] = value; + } + } + break; + } + case DOUBLE: + { + double value; + if(type == 'I') + value = INFINITY; + else if(type == 'N') + value = NAN; + for( i = 0; i < N; i++ ) + { + for( j = 0; j < M; j++ ) + { + ((double *)A)[i * LDA + j] = value; + } + } + break; + } + case COMPLEX: + { + float value; + if(type == 'I') + value = INFINITY; + else if(type == 'N') + value = NAN; + for( i = 0; i < N; i++ ) + { + for( j = 0; j < M; j++ ) + { + ((scomplex *)A)[i * LDA + j].real = value; + ((scomplex *)A)[i * LDA + j].imag = value; + } + } + break; + } + case DOUBLE_COMPLEX: + { + double value; + if(type == 'I') + value = INFINITY; + else if(type == 'N') + value = NAN; + for( i = 0; i < N; i++ ) + { + for( j = 0; j < M; j++ ) + { + ((dcomplex *)A)[i * LDA + j].real = value; + ((dcomplex *)A)[i * LDA + j].imag = value; + } + } + break; + } + } + + return; +} + +/*Intialize matrix according to given input*/ +void init_matrix(integer datatype, void *A, integer M, integer N, integer LDA, FILE* g_ext_fptr, char imatrix_char) +{ + if(g_ext_fptr != NULL) + init_matrix_from_file(datatype, A, M, N, LDA, g_ext_fptr); + else if(imatrix_char == 'I' || imatrix_char == 'N') + init_matrix_spec_in(datatype, A, M, N, LDA, imatrix_char); + else + rand_matrix(datatype, A, M, N, LDA); } \ No newline at end of file diff --git a/test/main/validate_src/test_common.h b/test/main/validate_src/test_common.h index 315609824..40092b3a0 100644 --- a/test/main/validate_src/test_common.h +++ b/test/main/validate_src/test_common.h @@ -15,6 +15,7 @@ #include "blis.h" #include "test_prototype.h" +#include "validate_common.h" // global variables extern integer i_zero , i_one , i_n_one; @@ -97,7 +98,7 @@ void init_matrix_from_file(integer datatype, void* A,integer m, integer n, integ /* Reading vector input data from a file */ void init_vector_from_file(integer datatype, void* A, integer m, integer inc, FILE* fptr); /* Allocate dynamic memory. If FLA_MEM_UNALIGNED is set, unaligned memory is allocated */ -char* fla_mem_alloc(integer size); +char* fla_mem_alloc(size_t size); /* Generate Hessenberg matrix */ void get_hessenberg_matrix(integer datatype, integer n, void* A, integer lda, void *Z, integer ldz, integer *ilo, integer *ihi, void* scale, integer *info); /* Convert matrix to upper hessenberg form */ @@ -114,4 +115,10 @@ void get_orthogonal_matrix_from_QR(integer datatype, integer n, void *A, integer void print_matrix(char* desc, integer datatype, integer M, integer N, void* A, integer lda); /* Get upper triangular matrix or lower triangular matrix based on UPLO */ void get_triangular_matrix(char *uplo, integer datatype, integer m, integer n, void *a, integer lda); +/*To Check order of Singular values of SVD (positive and non-decreasing)*/ +double svd_check_order(integer datatype, void *s, integer m, integer n, double residual); +/* Intialize matrix with special values*/ +void init_matrix_spec_in(integer datatype, void *A, integer M, integer N, integer LDA, char type); +/*Intialize matrix according to given input*/ +void init_matrix(integer datatype, void *A, integer M, integer N, integer LDA, FILE* g_ext_fptr, char imatrix_char); #endif // TEST_COMMON_H diff --git a/test/main/validate_src/test_prototype.h b/test/main/validate_src/test_prototype.h index c6d55c3af..635235b65 100644 --- a/test/main/validate_src/test_prototype.h +++ b/test/main/validate_src/test_prototype.h @@ -225,6 +225,26 @@ #define fla_lapack_cgghrd CGGHRD_ #define fla_lapack_zgghrd ZGGHRD_ +#define fla_lapack_srot SROT_ +#define fla_lapack_drot DROT_ +#define fla_lapack_crot CROT_ +#define fla_lapack_zrot ZROT_ + +#define fla_lapack_slartg SLARTG_ +#define fla_lapack_dlartg DLARTG_ +#define fla_lapack_clartg CLARTG_ +#define fla_lapack_zlartg ZLARTG_ + +#define fla_lapack_sorg2r SORG2R_ +#define fla_lapack_dorg2r DORG2R_ +#define fla_lapack_cung2r CUNG2R_ +#define fla_lapack_zung2r ZUNG2R_ + +#define fla_lapack_ssyevx SSYEVX_ +#define fla_lapack_dsyevx DSYEVX_ +#define fla_lapack_cheevx CHEEVX_ +#define fla_lapack_zheevx ZHEEVX_ + #elif (UPPER) #define fla_lapack_sladiv SLADIV @@ -441,6 +461,26 @@ #define fla_lapack_cgghrd CGGHRD #define fla_lapack_zgghrd ZGGHRD +#define fla_lapack_srot SROT +#define fla_lapack_drot DROT +#define fla_lapack_crot CROT +#define fla_lapack_zrot ZROT + +#define fla_lapack_slartg SLARTG +#define fla_lapack_dlartg DLARTG +#define fla_lapack_clartg CLARTG +#define fla_lapack_zlartg ZLARTG + +#define fla_lapack_sorg2r SORG2R +#define fla_lapack_dorg2r DORG2R +#define fla_lapack_cung2r CUNG2R +#define fla_lapack_zung2r ZUNG2R + +#define fla_lapack_ssyevx SSYEVX +#define fla_lapack_dsyevx DSYEVX +#define fla_lapack_cheevx CHEEVX +#define fla_lapack_zheevx ZHEEVX + #elif (LOWER) #define fla_lapack_sladiv sladiv @@ -657,6 +697,26 @@ #define fla_lapack_cgghrd cgghrd #define fla_lapack_zgghrd zgghrd +#define fla_lapack_srot srot +#define fla_lapack_drot drot +#define fla_lapack_crot crot +#define fla_lapack_zrot zrot + +#define fla_lapack_slartg slartg +#define fla_lapack_dlartg dlartg +#define fla_lapack_clartg clartg +#define fla_lapack_zlartg zlartg + +#define fla_lapack_sorg2r sorg2r +#define fla_lapack_dorg2r dorg2r +#define fla_lapack_cung2r cung2r +#define fla_lapack_zung2r zung2r + +#define fla_lapack_ssyevx ssyevx +#define fla_lapack_dsyevx dsyevx +#define fla_lapack_cheevx cheevx +#define fla_lapack_zheevx zheevx + #else #define fla_lapack_sladiv sladiv_ @@ -873,6 +933,26 @@ #define fla_lapack_cgghrd cgghrd_ #define fla_lapack_zgghrd zgghrd_ +#define fla_lapack_srot srot_ +#define fla_lapack_drot drot_ +#define fla_lapack_crot crot_ +#define fla_lapack_zrot zrot_ + +#define fla_lapack_slartg slartg_ +#define fla_lapack_dlartg dlartg_ +#define fla_lapack_clartg clartg_ +#define fla_lapack_zlartg zlartg_ + +#define fla_lapack_sorg2r sorg2r_ +#define fla_lapack_dorg2r dorg2r_ +#define fla_lapack_cung2r cung2r_ +#define fla_lapack_zung2r zung2r_ + +#define fla_lapack_ssyevx ssyevx_ +#define fla_lapack_dsyevx dsyevx_ +#define fla_lapack_cheevx cheevx_ +#define fla_lapack_zheevx zheevx_ + #endif /*if UPPER_*/ /* These functions are API invoking functions used in other API test codes */ diff --git a/test/main/validate_src/validate_common.h b/test/main/validate_src/validate_common.h index f1e8802c9..d91e4146f 100644 --- a/test/main/validate_src/validate_common.h +++ b/test/main/validate_src/validate_common.h @@ -10,8 +10,6 @@ #ifndef VALIDATE_COMMON_H #define VALIDATE_COMMON_H -#include "test_common.h" - void validate_geqrf(integer m_A, integer n_A, void *A, @@ -351,4 +349,24 @@ void validate_gehrd(integer n, double* residual, integer *info); +void validate_rot(integer datatype, + integer n, + void *cx, + void *cx_test, + integer incx, + void *cy, + void *cy_test, + integer incy, + void *c, + void *s, + double* residual); + +void validate_lartg(integer datatype, + void *f, + void *g, + void *r, + void *c, + void *s, + double* residual); + #endif // VALIDATE_COMMON_H diff --git a/test/main/validate_src/validate_geev.c b/test/main/validate_src/validate_geev.c index 09a4d1740..c63c3ca79 100644 --- a/test/main/validate_src/validate_geev.c +++ b/test/main/validate_src/validate_geev.c @@ -24,6 +24,8 @@ void validate_geev(char* jobvl, char* jobvr, double* residual, integer* info) { + if(m == 0) + return; void *work = NULL; void *lambda = NULL, *Vlambda = NULL; *info = 0; diff --git a/test/main/validate_src/validate_geevx.c b/test/main/validate_src/validate_geevx.c index abff22958..9aa5d76e4 100644 --- a/test/main/validate_src/validate_geevx.c +++ b/test/main/validate_src/validate_geevx.c @@ -31,6 +31,8 @@ void validate_geevx(char* jobvl, char* jobvr, double* residual, integer* info) { + if(m == 0) + return; void *work = NULL; void *lambda = NULL, *Vlambda = NULL; *info = 0; diff --git a/test/main/validate_src/validate_gehrd.c b/test/main/validate_src/validate_gehrd.c index 49e427ad0..2ca29d67b 100644 --- a/test/main/validate_src/validate_gehrd.c +++ b/test/main/validate_src/validate_gehrd.c @@ -19,6 +19,8 @@ void validate_gehrd(integer n, double* residual, integer *info) { + if(n == 0) + return; void *Q = NULL, *work = NULL, *lambda = NULL; integer lwork = -1; *info = 0; diff --git a/test/main/validate_src/validate_gelqf.c b/test/main/validate_src/validate_gelqf.c index 54afa73f6..d22fcf6fa 100644 --- a/test/main/validate_src/validate_gelqf.c +++ b/test/main/validate_src/validate_gelqf.c @@ -18,6 +18,8 @@ void validate_gelqf(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; void *Q = NULL, *L = NULL, *work = NULL; integer min_A; integer lwork = -1; diff --git a/test/main/validate_src/validate_geqp3.c b/test/main/validate_src/validate_geqp3.c index cd5904211..777035e0d 100644 --- a/test/main/validate_src/validate_geqp3.c +++ b/test/main/validate_src/validate_geqp3.c @@ -18,6 +18,8 @@ void validate_geqp3(integer m_A, integer n_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; void *Q = NULL, *R = NULL, *work = NULL; integer min_A; integer lwork = -1, FLA_TRUE = 1; diff --git a/test/main/validate_src/validate_geqrf.c b/test/main/validate_src/validate_geqrf.c index dffc19c89..8132b106e 100644 --- a/test/main/validate_src/validate_geqrf.c +++ b/test/main/validate_src/validate_geqrf.c @@ -18,6 +18,8 @@ void validate_geqrf(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; void *Q = NULL, *R = NULL, *work = NULL; integer min_A; integer lwork = -1; diff --git a/test/main/validate_src/validate_gerq2.c b/test/main/validate_src/validate_gerq2.c index 6f387d3de..7fba844f0 100644 --- a/test/main/validate_src/validate_gerq2.c +++ b/test/main/validate_src/validate_gerq2.c @@ -18,6 +18,8 @@ void validate_gerq2(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; void *R = NULL, *Q = NULL, *work = NULL; integer min_A, diff_A; integer lwork = -1; diff --git a/test/main/validate_src/validate_gerqf.c b/test/main/validate_src/validate_gerqf.c index 475b06150..35dbaaca1 100644 --- a/test/main/validate_src/validate_gerqf.c +++ b/test/main/validate_src/validate_gerqf.c @@ -18,6 +18,8 @@ void validate_gerqf(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; void *R, *Q, *work; integer min_A, diff_A; integer lwork = -1; diff --git a/test/main/validate_src/validate_gesdd.c b/test/main/validate_src/validate_gesdd.c index f0067cf88..3826b16ac 100644 --- a/test/main/validate_src/validate_gesdd.c +++ b/test/main/validate_src/validate_gesdd.c @@ -10,6 +10,8 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, integer lda, void* s, void* U, integer ldu, void* V, integer ldvt, integer datatype, double *residual, integer* info) { + if(m == 0 || n == 0) + return; void *sigma = NULL, *Usigma = NULL; void *work = NULL; *info = 0; @@ -24,7 +26,7 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, int { case FLOAT: { - float norm, norm_A, eps, resid1, resid2, resid3; + float norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_slamch("P"); /* Test 1 @@ -43,13 +45,17 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, int compute norm(I - V*V') / (N * EPS)*/ resid3 = (float)check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular values of SVD (positive and non-decreasing) */ + resid4 = (float)svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case DOUBLE: { - double norm, norm_A, eps, resid1, resid2, resid3; + double norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_dlamch("P"); /* Test 1 @@ -67,14 +73,18 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, int /* Test 3 compute norm(I - V*V') / (N * EPS)*/ resid3 = check_orthogonality(datatype, V, n, n, ldvt); + + /* Test 4 + Test to Check order of Singular values of SVD (positive and non-decreasing) */ + resid4 = svd_check_order( datatype, s, m, n, *residual ); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case COMPLEX: { - float norm, norm_A, eps, resid1, resid2, resid3; + float norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_slamch("P"); /* Test 1 @@ -93,13 +103,17 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, int compute norm(I - V*V') / (N * EPS)*/ resid3 = (float)check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular values of SVD (positive and non-decreasing) */ + resid4 = (float)svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case DOUBLE_COMPLEX: { - double norm, norm_A, eps, resid1, resid2, resid3; + double norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_dlamch("P"); /* Test 1 @@ -118,7 +132,11 @@ void validate_gesdd(char *jobz, integer m, integer n, void* A, void* A_test, int compute norm(I - V*V') / (N * EPS)*/ resid3 = check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular values of SVD (positive and non-decreasing) */ + resid4 = svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } } diff --git a/test/main/validate_src/validate_gesv.c b/test/main/validate_src/validate_gesv.c index 6dc99cd36..656ec2fff 100644 --- a/test/main/validate_src/validate_gesv.c +++ b/test/main/validate_src/validate_gesv.c @@ -19,6 +19,8 @@ void validate_gesv(integer n, double* residual, integer* info) { + if(n == 0 || nrhs == 0) + return; void* work = NULL; integer ldx; *info = 0; diff --git a/test/main/validate_src/validate_gesvd.c b/test/main/validate_src/validate_gesvd.c index ce8d5d259..9d3a96933 100644 --- a/test/main/validate_src/validate_gesvd.c +++ b/test/main/validate_src/validate_gesvd.c @@ -10,6 +10,8 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void* A_test, integer lda, void* s, void* U, integer ldu, void* V, integer ldvt, integer datatype, double *residual, integer* info) { + if(m == 0 || n == 0) + return; void *sigma = NULL, *Usigma = NULL; void *work = NULL; *info = 0; @@ -24,7 +26,7 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void { case FLOAT: { - float norm, norm_A, eps, resid1, resid2, resid3; + float norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_slamch("P"); /* Test 1 @@ -43,13 +45,17 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void compute norm(I - V*V') / (N * EPS)*/ resid3 = (float)check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular SVD values (positive and non-decreasing) */ + resid4 = (float) svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case DOUBLE: - { - double norm, norm_A, eps, resid1, resid2, resid3; + { + double norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_dlamch("P"); /* Test 1 @@ -68,13 +74,17 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void compute norm(I - V*V') / (N * EPS)*/ resid3 = check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular SVD values (positive and non-decreasing) */ + resid4 = svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case COMPLEX: { - float norm, norm_A, eps, resid1, resid2, resid3; + float norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_slamch("P"); /* Test 1 @@ -93,13 +103,17 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void compute norm(I - V*V') / (N * EPS)*/ resid3 = (float)check_orthogonality(datatype, V, n, n, ldvt); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + /* Test 4 + Test to Check order of Singular SVD values (positive and non-decreasing) */ + resid4 = (float) svd_check_order( datatype, s, m, n, *residual ); + + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } case DOUBLE_COMPLEX: { - double norm, norm_A, eps, resid1, resid2, resid3; + double norm, norm_A, eps, resid1, resid2, resid3, resid4; eps = fla_lapack_dlamch("P"); /* Test 1 @@ -117,8 +131,12 @@ void validate_gesvd(char *jobu, char *jobvt, integer m, integer n, void* A, void /* Test 3 compute norm(I - V*V') / (N * EPS)*/ resid3 = check_orthogonality(datatype, V, n, n, ldvt); + + /* Test 4 + Test to Check order of Singular SVD values (positive and non-decreasing) */ + resid4 = svd_check_order( datatype, s, m, n, *residual ); - *residual = (double)fla_max(resid1, fla_max(resid2, resid3)); + *residual = (double)fla_max(fla_max(resid1, fla_max(resid2, resid3)), resid4); break; } } diff --git a/test/main/validate_src/validate_getrf.c b/test/main/validate_src/validate_getrf.c index 4ee800347..878d9a28f 100644 --- a/test/main/validate_src/validate_getrf.c +++ b/test/main/validate_src/validate_getrf.c @@ -18,6 +18,8 @@ void validate_getrf(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; /* System generated locals */ integer m_n_vector, min_A; integer m_L, n_L, m_U, n_U, k; diff --git a/test/main/validate_src/validate_getri.c b/test/main/validate_src/validate_getri.c index e19a75d69..c0da0ee19 100644 --- a/test/main/validate_src/validate_getri.c +++ b/test/main/validate_src/validate_getri.c @@ -18,6 +18,8 @@ void validate_getri(integer m_A, double* residual, integer* info) { + if(m_A == 0 || n_A == 0) + return; /* System generated locals */ void *a_temp, *work; *info = 0; diff --git a/test/main/validate_src/validate_getrs.c b/test/main/validate_src/validate_getrs.c index 4f36b753e..bfb189e8f 100644 --- a/test/main/validate_src/validate_getrs.c +++ b/test/main/validate_src/validate_getrs.c @@ -20,6 +20,8 @@ void validate_getrs(char *trans, double* residual, integer* info) { + if(n == 0 || nrhs == 0) + return; void* work = NULL; integer ldx; *info = 0; diff --git a/test/main/validate_src/validate_ggev.c b/test/main/validate_src/validate_ggev.c index be41e1377..cfad7a654 100644 --- a/test/main/validate_src/validate_ggev.c +++ b/test/main/validate_src/validate_ggev.c @@ -10,6 +10,8 @@ void validate_ggev(char* jobvl, char* jobvr, integer n, void* A, integer lda, void* B, integer ldb, void* alpha, void* alphar, void* alphai, void* beta, void* VL, integer ldvl, void* VR, integer ldvr, integer datatype, double *residual, integer* info) { + if(n == 0) + return; integer i, j; void *work = NULL; *info = 0; diff --git a/test/main/validate_src/validate_ggevx.c b/test/main/validate_src/validate_ggevx.c index afe8119f2..a995aad7c 100644 --- a/test/main/validate_src/validate_ggevx.c +++ b/test/main/validate_src/validate_ggevx.c @@ -10,6 +10,8 @@ void validate_ggevx(char* balanc, char* jobvl, char* jobvr, char* sense, integer n, void* A, integer lda, void* B, integer ldb, void* alpha, void* alphar, void* alphai, void* beta, void* VL, integer ldvl, void* VR, integer ldvr, integer datatype, double *residual, integer* info) { + if(n == 0) + return; integer i, j; void *work = NULL; *info = 0; diff --git a/test/main/validate_src/validate_gghrd.c b/test/main/validate_src/validate_gghrd.c index 20ece0e02..61acc59e9 100644 --- a/test/main/validate_src/validate_gghrd.c +++ b/test/main/validate_src/validate_gghrd.c @@ -27,6 +27,8 @@ void validate_gghrd(char* compq, double* residual, integer *info) { + if(n == 0) + return; if (*compz == 'N' || *compq == 'N') return; diff --git a/test/main/validate_src/validate_hseqr.c b/test/main/validate_src/validate_hseqr.c index 57214db85..031747bce 100644 --- a/test/main/validate_src/validate_hseqr.c +++ b/test/main/validate_src/validate_hseqr.c @@ -20,6 +20,8 @@ void validate_hseqr(char* job, char* compz, double* residual, integer *info) { + if(n == 0) + return; if (*job == 'E' || *compz == 'N') return; diff --git a/test/main/validate_src/validate_lartg.c b/test/main/validate_src/validate_lartg.c new file mode 100644 index 000000000..a9b0ebaa8 --- /dev/null +++ b/test/main/validate_src/validate_lartg.c @@ -0,0 +1,164 @@ +/****************************************************************************** +* Copyright (C) 2022-2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file validate_rot.c + * @brief Defines validate function of ROT() to use in test suite. + * */ + +#include "test_common.h" +void validate_lartg(integer datatype, void *f, void *g, void *r, void *c, void *s, double* residual) +{ + void *out_zero = NULL; + create_vector(datatype, &out_zero, 1); + reset_vector(datatype, out_zero, 1, 1); + + switch(datatype) + { + case FLOAT: + { + float resid1 = 0.0; + float resid2 = 0.0; + float eps, norm_r, norm_f, norm_res, norm_1; + float res = 0.0; + + eps = fla_lapack_slamch("P"); + + /*Test 1 validating C and S */ + norm_1 = snrm2_(&i_one, &s_one, &i_one); + /*square root of ((c*c) + (s*s)) = 1*/ + res = sqrt((((float *)c)[0]*((float *)c)[0]) + (((float *)s)[0]*((float *)s)[0])); + /*res->res-1*/ + saxpy_(&i_one, &s_n_one, &s_one, &i_one, &res, &i_one); + norm_res = snrm2_(&i_one, &res, &i_one); + resid1 = (norm_res/ norm_1/ eps); + + /*Test 2 Validating R*/ + norm_r = snrm2_(&i_one, r, &i_one); + /*Hermitian Transpose of original rotation vector*/ + ((float *)s)[0] = -((float *)s)[0]; + /*Rotating output vectors*/ + fla_lapack_srot(&i_one, r, &i_one, out_zero, &i_one,((float *)c), ((float *)s)); + + /*r-f*/ + saxpy_(&i_one, &s_n_one, f, &i_one, r, &i_one); + saxpy_(&i_one, &s_n_one, g, &i_one, out_zero, &i_one); + + norm_f = snrm2_(&i_one, r, &i_one); + resid2 = (norm_f/ norm_r/ eps); + + *residual = (double)fla_max(resid1, resid2); + break; + } + + case DOUBLE: + { + double resid1 = 0.0; + double resid2 = 0.0; + double eps, norm_r, norm_f, norm_res, norm_1; + double res = 0.0; + + eps = fla_lapack_slamch("P"); + + /*Test 1 validating C and S */ + norm_1 = dnrm2_(&i_one, &d_one, &i_one); + /*square root of ((c*c) + (s*s)) = 1*/ + res = sqrt((((double *)c)[0]*((double *)c)[0]) + (((double *)s)[0]*((double *)s)[0])); + /*res->res -1*/ + daxpy_(&i_one, &d_n_one, &d_one, &i_one, &res, &i_one); + norm_res = dnrm2_(&i_one, &res, &i_one); + resid1 = (norm_res/ norm_1/ eps); + + /*Test 2 Validating R*/ + norm_r = dnrm2_(&i_one, r, &i_one); + /*Hermitian Transpose of original rotation vector*/ + ((double *)s)[0] = -((double *)s)[0]; + /*Rotating output vectors*/ + fla_lapack_drot(&i_one, r, &i_one, out_zero, &i_one,((double *)c), ((double *)s)); + + /*r-f*/ + daxpy_(&i_one, &d_n_one, f, &i_one, r, &i_one); + daxpy_(&i_one, &d_n_one, g, &i_one, out_zero, &i_one); + norm_f = dnrm2_(&i_one, r, &i_one); + resid2 = (norm_f/ norm_r/ eps); + + *residual = (double)fla_max(resid1, resid2); + break; + } + + case COMPLEX: + { + float resid1 = 0.0; + float resid2 = 0.0; + float eps, norm_r, norm_f, norm_res, norm_1; + float res = 0.0;; + + eps = fla_lapack_slamch("P"); + + /*Test 1 validating C and S */ + norm_1 = snrm2_(&i_one, &c_one, &i_one); + /*square root of ((c*c) + (s*s)) = 1*/ + res = sqrt((((float *)c)[0]*((float *)c)[0]) + (((scomplex *)s)[0].real*((scomplex *)s)[0].real) + + (((scomplex *)s)[0].imag*((scomplex *)s)[0].imag)); + /*res->res - 1*/ + saxpy_(&i_one, &s_n_one, &s_one, &i_one, &res, &i_one); + norm_res = snrm2_(&i_one, &res, &i_one); + resid1 = (norm_res/ norm_1/ eps); + + /*Test 2 Validating R*/ + norm_r = scnrm2_(&i_one, r, &i_one); + /*Hermitian Transpose of original rotation vector*/ + ((scomplex *)s)[0].real = -((scomplex *)s)[0].real; + ((scomplex *)s)[0].imag = -((scomplex *)s)[0].imag; + /*Rotating output vectors*/ + fla_lapack_crot(&i_one, r, &i_one, out_zero, &i_one,((float *)c), ((scomplex *)s)); + + /*r-f*/ + caxpy_(&i_one, &c_n_one, f, &i_one, r, &i_one); + caxpy_(&i_one, &c_n_one, g, &i_one, out_zero, &i_one); + norm_f = scnrm2_(&i_one, r, &i_one); + resid2 = (norm_f/ norm_r/ eps); + + *residual = (double)fla_max(resid1, resid2); + break; + } + + case DOUBLE_COMPLEX: + { + double resid1 = 0.0; + double resid2 = 0.0; + double eps, norm_r, norm_f, norm_res, norm_1; + double res = 0.0; + + eps = fla_lapack_slamch("P"); + + /*Test 1 validating C and S */ + norm_1 = snrm2_(&i_one, &c_one, &i_one); + /*square root of ((c*c) + (s*s)) = 1*/ + res = sqrt((((double *)c)[0]*((double *)c)[0]) + (((dcomplex *)s)[0].real*((dcomplex *)s)[0].real) + + (((dcomplex *)s)[0].imag*((dcomplex *)s)[0].imag)); + /*res-> res - 1*/ + daxpy_(&i_one, &d_n_one, &d_one, &i_one, &res, &i_one); + norm_res = dnrm2_(&i_one, &res, &i_one); + resid1 = (norm_res/ norm_1/ eps); + + /*Test 2 Validating R*/ + norm_r = dznrm2_(&i_one, r, &i_one); + /*Hermitian Transpose of original rotation vector*/ + ((dcomplex *)s)[0].real = -((dcomplex *)s)[0].real; + ((dcomplex *)s)[0].imag = -((dcomplex *)s)[0].imag; + /*Rotating output vectors*/ + fla_lapack_zrot(&i_one, r, &i_one, out_zero, &i_one,((double *)c), ((dcomplex *)s)); + + /*r-f*/ + zaxpy_(&i_one, &z_n_one, f, &i_one, r, &i_one); + zaxpy_(&i_one, &z_n_one, g, &i_one, out_zero, &i_one); + norm_f = dznrm2_(&i_one, r, &i_one); + resid2 = (norm_f/ norm_r/ eps); + + *residual = (double)fla_max(resid1, resid2); + break; + } + } + free_vector(out_zero); +} \ No newline at end of file diff --git a/test/main/validate_src/validate_orgqr.c b/test/main/validate_src/validate_orgqr.c index 096c24d9c..364695e81 100644 --- a/test/main/validate_src/validate_orgqr.c +++ b/test/main/validate_src/validate_orgqr.c @@ -19,6 +19,8 @@ void validate_orgqr(integer m, double* residual, integer* info) { + if(m == 0 || n == 0) + return; integer k; *info = 0; diff --git a/test/main/validate_src/validate_potrf.c b/test/main/validate_src/validate_potrf.c index 56b214e9a..29657a13d 100644 --- a/test/main/validate_src/validate_potrf.c +++ b/test/main/validate_src/validate_potrf.c @@ -10,6 +10,8 @@ void validate_potrf(char *uplo, integer m, void *A, void *A_test, integer lda, integer datatype, double* residual, integer* info) { + if(m == 0) + return; void *b = NULL, *x = NULL; void *x_test = NULL, *b_test = NULL; void *work = NULL; diff --git a/test/main/validate_src/validate_potrs.c b/test/main/validate_src/validate_potrs.c index 99cc406e1..1275b77a9 100644 --- a/test/main/validate_src/validate_potrs.c +++ b/test/main/validate_src/validate_potrs.c @@ -19,6 +19,8 @@ void validate_potrs(integer n, double* residual, integer* info) { + if(n == 0 || nrhs == 0) + return; void* work = NULL; integer ldx; *info = 0; diff --git a/test/main/validate_src/validate_rot.c b/test/main/validate_src/validate_rot.c new file mode 100644 index 000000000..915861b39 --- /dev/null +++ b/test/main/validate_src/validate_rot.c @@ -0,0 +1,128 @@ +/****************************************************************************** +* Copyright (C) 2022-2023, Advanced Micro Devices, Inc. All rights reserved. +*******************************************************************************/ + +/*! @file validate_rot.c + * @brief Defines validate function of ROT() to use in test suite. + * */ + +#include "test_common.h" +void validate_rot(integer datatype, integer n, void *cx, void *cx_test, integer incx, void *cy, void *cy_test, integer incy, void *c, void *s, double* residual) +{ + switch(datatype) + { + case FLOAT: + { + float resid1 = 0.0; + float resid2 = 0.0; + float eps = fla_lapack_slamch("P"); + float norm_resid1, norm_resid2, norm_cx, norm_cy; + + norm_cx = snrm2_(&n, cx, &incx); + norm_cy = snrm2_(&n, cy, &incy); + /*Hermitian Transpose of original rotation vector*/ + ((float *)s)[0] = -((float *)s)[0]; + + /*Rotating output vectors*/ + fla_lapack_srot(&n, cx, &incx, cy, &incy,((float *)c), ((float *)s)); + + /*cx-cx_test*/ + saxpy_(&n, &s_n_one, cx_test, &incx, cx, &incx); + saxpy_(&n, &s_n_one, cy_test, &incy, cy, &incy); + + norm_resid1 = fla_max(resid1, snrm2_(&n, cx, &incx)); + resid1 = (norm_resid1)/ eps/ norm_cx/ ((float)n); + norm_resid2 = fla_max(resid2, snrm2_(&n, cy, &incy)); + resid2 = (norm_resid2)/ eps/ norm_cy/ ((float)n); + + *residual = (double)fla_max(resid1, resid2); + break; + } + + case DOUBLE: + { + double resid1 = 0.f; + double resid2 = 0.f; + double eps = fla_lapack_slamch("P"); + double norm_resid1, norm_resid2, norm_cx, norm_cy; + + norm_cx = dnrm2_(&n, cx, &incx); + norm_cy = dnrm2_(&n, cy, &incy); + /*Hermitian Transpose of original rotation vector*/ + ((double *)s)[0] = -((double *)s)[0]; + + /*Rotating output vectors*/ + fla_lapack_drot(&n, cx, &incx, cy, &incy,((double *)c), ((double *)s)); + + /*cx-cx_test*/ + daxpy_(&n, &d_n_one, cx_test, &incx, cx, &incx); + daxpy_(&n, &d_n_one, cy_test, &incy, cy, &incy); + + norm_resid1 = fla_max(resid1, dnrm2_(&n, cx, &incx)); + resid1 = (norm_resid1)/ eps/ norm_cx/ ((double)n); + norm_resid2 = fla_max(resid2, dnrm2_(&n, cy, &incy)); + resid2 = (norm_resid2)/ eps/ norm_cy/ ((double)n); + + *residual = (double)fla_max(resid1, resid2); + break; + } + case COMPLEX: + { + float resid1 = 0.0; + float resid2 = 0.0; + float eps = fla_lapack_slamch("P"); + float norm_resid1, norm_resid2, norm_cx, norm_cy; + + norm_cx = scnrm2_(&n, cx, &incx); + norm_cy = scnrm2_(&n, cy, &incy); + + /*Hermitian Transpose of original rotation vector*/ + ((scomplex *)s)[0].real = -((scomplex *)s)[0].real; + ((scomplex *)s)[0].imag = -((scomplex *)s)[0].imag; + + /*Rotating output vectors*/ + fla_lapack_crot(&n, cx, &incx, cy, &incy,((float *)c), ((scomplex *)s)); + + /*cx-cx_test*/ + caxpy_(&n, &c_n_one, cx_test, &incx, cx, &incx); + caxpy_(&n, &c_n_one, cy_test, &incy, cy, &incy); + + norm_resid1 = fla_max(resid1, scnrm2_(&n, cx, &incx)); + resid1 = (norm_resid1)/ eps/ norm_cx/ ((float)n); + norm_resid2 = fla_max(resid2, scnrm2_(&n, cy, &incy)); + resid2 = (norm_resid2)/ eps/ norm_cy/ ((float)n); + + *residual = (double)fla_max(resid1, resid2); + break; + } + case DOUBLE_COMPLEX: + { + double resid1 = 0.f; + double resid2 = 0.f; + double eps = fla_lapack_slamch("P"); + double norm_resid1, norm_resid2, norm_cx, norm_cy; + + norm_cx = dnrm2_(&n, cx, &incx); + norm_cy = dnrm2_(&n, cy, &incy); + + /*Hermitian Transpose of original rotation vector*/ + ((dcomplex *)s)[0].real = -((dcomplex *)s)[0].real; + ((dcomplex *)s)[0].imag = -((dcomplex *)s)[0].imag; + + /*Rotating output vectors*/ + fla_lapack_zrot(&n, cx, &incx, cy, &incy,((double *)c), ((dcomplex *)s)); + + /*cx-cx_test*/ + zaxpy_(&n, &z_n_one, cx_test, &incx, cx, &incx); + zaxpy_(&n, &z_n_one, cy_test, &incy, cy, &incy); + + norm_resid1 = fla_max(resid1, dznrm2_(&n, cx, &incx)); + resid1 = (norm_resid1)/ eps/ norm_cx/ ((double)n); + norm_resid2 = fla_max(resid2, dznrm2_(&n, cy, &incy)); + resid2 = (norm_resid2)/ eps/ norm_cy/ ((double)n); + + *residual = (double)fla_max(resid1, resid2); + break; + } + } +} \ No newline at end of file diff --git a/test/main/validate_src/validate_spffrt2.c b/test/main/validate_src/validate_spffrt2.c index 386439b50..f715dda14 100644 --- a/test/main/validate_src/validate_spffrt2.c +++ b/test/main/validate_src/validate_spffrt2.c @@ -15,6 +15,8 @@ void validate_spffrt2(integer n, integer datatype, double* residual) { + if(n == 0 || ncolm == 0) + return; integer i, j, di; void* work = NULL; void* L = NULL, *D = NULL, *T = NULL; diff --git a/test/main/validate_src/validate_spffrtx.c b/test/main/validate_src/validate_spffrtx.c index a0f5d6a6a..8e6efbc92 100644 --- a/test/main/validate_src/validate_spffrtx.c +++ b/test/main/validate_src/validate_spffrtx.c @@ -15,6 +15,8 @@ void validate_spffrtx(integer n, integer datatype, double* residual) { + if(n == 0 || ncolm == 0) + return; integer i, j, di; void* work = NULL; void* L = NULL, *D = NULL, *T = NULL; diff --git a/test/main/validate_src/validate_stedc.c b/test/main/validate_src/validate_stedc.c index d9b9de542..7cda68d5e 100644 --- a/test/main/validate_src/validate_stedc.c +++ b/test/main/validate_src/validate_stedc.c @@ -13,6 +13,8 @@ if compz = N.*/ void validate_stedc(char compz, integer n, void* D_test, void* Z_input, void* Z, integer ldz, integer datatype, double* residual, integer* info) { + if(n == 0) + return; void *lambda = NULL, *zlambda = NULL; void *a_temp = NULL; void *work = NULL; diff --git a/test/main/validate_src/validate_syevd.c b/test/main/validate_src/validate_syevd.c index f7bd68e7e..f7abd00ba 100644 --- a/test/main/validate_src/validate_syevd.c +++ b/test/main/validate_src/validate_syevd.c @@ -10,6 +10,8 @@ void validate_syevd(char* jobz, integer n, void* A, void* A_test, integer lda, void* w, integer datatype, double* residual, integer* info) { + if(n == 0) + return; *info = 0; if(*jobz != 'N') {