diff --git a/CMakeLists.txt b/CMakeLists.txt index 3ca797c2129058e1db8af4ce189a3565b5243306..55a783a3886827e8b5a156cb7fc8c63f02f0e311 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-16 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 3.3) @@ -36,9 +36,9 @@ if("${PROJECT_SOURCE_DIR}" STREQUAL "${PROJECT_BINARY_DIR}") endif() # set project version number -set(CHAMELEON_VERSION_MAJOR 0) -set(CHAMELEON_VERSION_MINOR 9) -set(CHAMELEON_VERSION_MICRO 2) +set(CHAMELEON_VERSION_MAJOR 1) +set(CHAMELEON_VERSION_MINOR 0) +set(CHAMELEON_VERSION_MICRO 0) set(CHAMELEON_CMAKE_DIR "" CACHE PATH "Directory of CHAMELEON CMake modules, can be external to the project") @@ -189,8 +189,8 @@ if (CHAMELEON_RUNTIME_SYNC) message("-- ${BoldGreen}CHAMELEON_RUNTIME_SYNC is set to ON, turn it OFF to avoid synchronisation in the tasks submission${ColourReset}") endif() -# Options to enable/disable testings and timings -# ---------------------------------------------- +# Options to enable/disable doc, examples, and testings +# ----------------------------------------------------- option(CHAMELEON_ENABLE_DOC "Enable documentation build" OFF) if (CHAMELEON_ENABLE_DOC) message("-- ${BoldGreen}CHAMELEON_ENABLE_DOC is set to ON, turn it OFF to avoid building docs${ColourReset}") @@ -203,10 +203,6 @@ option(CHAMELEON_ENABLE_TESTING "Enable testings build" ON) if (CHAMELEON_ENABLE_TESTING) message("-- ${BoldGreen}CHAMELEON_ENABLE_TESTING is set to ON, turn it OFF to avoid building testing${ColourReset}") endif() -option(CHAMELEON_ENABLE_TIMING "Enable timings build" ON) -if (CHAMELEON_ENABLE_TIMING) - message("-- ${BoldGreen}CHAMELEON_ENABLE_TIMING is set to ON, turn it OFF to avoid building timing${ColourReset}") -endif() # Option to activate or not simulation mode (use Simgrid through StarPU) # ---------------------------------------------------------------------- @@ -993,17 +989,8 @@ endif(CHAMELEON_ENABLE_EXAMPLE AND NOT CHAMELEON_SIMULATION) # Testing executables if(CHAMELEON_ENABLE_TESTING) - add_subdirectory(new-testing) -endif(CHAMELEON_ENABLE_TESTING) - -if(CHAMELEON_ENABLE_EXAMPLE AND NOT CHAMELEON_SIMULATION) add_subdirectory(testing) -endif(CHAMELEON_ENABLE_EXAMPLE AND NOT CHAMELEON_SIMULATION) - -# Timing executables -if(CHAMELEON_ENABLE_TIMING) - add_subdirectory(timing) -endif(CHAMELEON_ENABLE_TIMING) +endif(CHAMELEON_ENABLE_TESTING) #------------------------------------------------------------------------------ # Define a target which gathers all targets of sources diff --git a/LICENCE.txt b/LICENCE.txt index 074ad18ca9dd5e73b9e034acb2a0a246735472d3..eba92e2947c1073192d1c290538db95f135c0541 100644 --- a/LICENCE.txt +++ b/LICENCE.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # @copyright 2016-2018 KAUST. All rights reserved. # diff --git a/cmake_modules/GenPkgConfig.cmake b/cmake_modules/GenPkgConfig.cmake index 1583761b0fba0eeae8ad8863a240902e8f5a786e..af8c90b88a7c4b361ed934d35c487d290bc4f2e8 100644 --- a/cmake_modules/GenPkgConfig.cmake +++ b/cmake_modules/GenPkgConfig.cmake @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-10 +# @date 2020-03-03 # ### diff --git a/cmake_modules/PrintOpts.cmake b/cmake_modules/PrintOpts.cmake index 7d34be2185396897aff3d6fc092689a36d6064f5..9fa5551b5f3f207e8aebbd5aee751ccd0f1f2f94 100644 --- a/cmake_modules/PrintOpts.cmake +++ b/cmake_modules/PrintOpts.cmake @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,9 +17,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2014-11-10 +# @date 2020-03-03 # ### @@ -56,14 +56,12 @@ set(dep_message "${dep_message}" " BLAS ................: ${BLAS_VENDOR_FOUND}\n" " LAPACK...............: ${LAPACK_VENDOR_FOUND}\n" "\n" -" Trace ...............: ${CHAMELEON_ENABLE_TRACING}\n" " Simulation mode .....: ${CHAMELEON_SIMULATION}\n" "\n" " Binaries to build\n" " documentation ........: ${CHAMELEON_ENABLE_DOC}\n" " example ..............: ${CHAMELEON_ENABLE_EXAMPLE}\n" " testing ..............: ${CHAMELEON_ENABLE_TESTING}\n" -" timing ...............: ${CHAMELEON_ENABLE_TIMING}\n" "\n" " CHAMELEON dependencies :\n") foreach (_dep ${CHAMELEON_LIBRARIES_DEP}) diff --git a/cmake_modules/local_subs.py b/cmake_modules/local_subs.py index 27be0cb14e5f6f323c43da7db0c28a862b50c46a..14b07b874208eb465c18c4912a387c7402da984f 100644 --- a/cmake_modules/local_subs.py +++ b/cmake_modules/local_subs.py @@ -76,7 +76,6 @@ subs = { ('codelet_p', 'codelet_s', 'codelet_d', 'codelet_c', 'codelet_z' ), ('runtime_p', 'runtime_s', 'runtime_d', 'runtime_c', 'runtime_z' ), ('testing_p', 'testing_s', 'testing_d', 'testing_c', 'testing_z' ), - ('timing_p', 'timing_s', 'timing_d', 'timing_c', 'timing_z' ), ('workspace_p', 'workspace_s', 'workspace_d', 'workspace_c', 'workspace_z' ), ('check_p', 'check_s', 'check_d', 'check_c', 'check_z' ), # ('CORE_P', 'CORE_S', 'CORE_D', 'CORE_C', 'CORE_Z' ), diff --git a/cmake_modules/morse_cmake b/cmake_modules/morse_cmake index bf907e276be1b3393e03bf63f962b5c03c283a80..657741dbab25d4008c4dfc2ebdf34a3f43bf00e6 160000 --- a/cmake_modules/morse_cmake +++ b/cmake_modules/morse_cmake @@ -1 +1 @@ -Subproject commit bf907e276be1b3393e03bf63f962b5c03c283a80 +Subproject commit 657741dbab25d4008c4dfc2ebdf34a3f43bf00e6 diff --git a/compute/CMakeLists.txt b/compute/CMakeLists.txt index b4987088743f21afc08b8d0183b30d4e6628ac8d..08b57c03a143511d510eef47e012c413dd2ecf00 100644 --- a/compute/CMakeLists.txt +++ b/compute/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/compute/map.c b/compute/map.c index 0b3632036e1ff2c5a36379938a64106a06a02665..960be5f5c8401b786ffadca4e7919af2881b494d 100644 --- a/compute/map.c +++ b/compute/map.c @@ -2,16 +2,16 @@ * * @file map.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-09-24 + * @date 2020-03-03 * */ #include "control/common.h" diff --git a/compute/pmap.c b/compute/pmap.c index 8d70ccae1e11ea0c6f4e93d39c47218acea053f9..4e568a3442656bc347520b6ff5be95e3c98bc205 100644 --- a/compute/pmap.c +++ b/compute/pmap.c @@ -2,16 +2,16 @@ * * @file pmap.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-09-24 + * @date 2020-03-03 * */ #include "control/common.h" diff --git a/compute/pzbuild.c b/compute/pzbuild.c index cd25892b84dc68dcced8794a779029263a2c6667..6c7c84cdce4a9a7473094dc1b1e81a498813556f 100644 --- a/compute/pzbuild.c +++ b/compute/pzbuild.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zbuild parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Guillaume Sylvand - * @date 2016-09-08 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgebrd_ge2gb.c b/compute/pzgebrd_ge2gb.c index 30b2a55ffba239741ef384b5fc27f39051e98738..17ef841fb4d1ac657be699c180c0a0a44bfd4aa5 100644 --- a/compute/pzgebrd_ge2gb.c +++ b/compute/pzgebrd_ge2gb.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgebrd_ge2gb parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgelqf.c b/compute/pzgelqf.c index c0e9b10052a7da83be3176a4c8b43812f4c9f849..9b8a1a7ba39822836deb0548e0656cb71f6c591f 100644 --- a/compute/pzgelqf.c +++ b/compute/pzgelqf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqf parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgelqf_param.c b/compute/pzgelqf_param.c index 5ba6cbe30d25eeebcb68fc94ab8465a404c7aff6..817477ab65998999964036708465aab15bf52131 100644 --- a/compute/pzgelqf_param.c +++ b/compute/pzgelqf_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqf_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-12 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgelqfrh.c b/compute/pzgelqfrh.c index 2b531416f21d3057026a75d3aeabc4f6d10e8672..dd23a7e536220ff1de7ac6243856b1ea8d9f2cba 100644 --- a/compute/pzgelqfrh.c +++ b/compute/pzgelqfrh.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqfrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgemm.c b/compute/pzgemm.c index 52b885d4099d3893994069f5c73cb86658a441ea..a67977fa4d91d4657e1fe68032441faab9035261 100644 --- a/compute/pzgemm.c +++ b/compute/pzgemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgeqrf.c b/compute/pzgeqrf.c index 29b03c6d8209d67dc86d295475ca4d023a7cbcd4..dd4c6394b5363c84ed6c5e69e03ffe81ced06c75 100644 --- a/compute/pzgeqrf.c +++ b/compute/pzgeqrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrf parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgeqrf_param.c b/compute/pzgeqrf_param.c index d6742f7c8057ea165d1f47c2840d4be890531e80..0831540e19f302dc8477787b3f48ec9ae798e72e 100644 --- a/compute/pzgeqrf_param.c +++ b/compute/pzgeqrf_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrf_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-03 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgeqrfrh.c b/compute/pzgeqrfrh.c index 6f51507f819ff4aabaa220748bb3b71163ba0bdf..7c8a75ede50154087f8d38e6c528481f4a98ea7f 100644 --- a/compute/pzgeqrfrh.c +++ b/compute/pzgeqrfrh.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrfrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgetrf_incpiv.c b/compute/pzgetrf_incpiv.c index 1e6b5513727f2b2f85fde9a6f8cfb50534c5198a..645ecfe75f35f53f1fdc6ed9664faf878465985a 100644 --- a/compute/pzgetrf_incpiv.c +++ b/compute/pzgetrf_incpiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_incpiv parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgetrf_nopiv.c b/compute/pzgetrf_nopiv.c index eb9d6ea29a77cd27c5f03b1ff9bb5b1d43ae07ad..3995e9cf8ceb42afccc81fa9a5ba116312996a22 100644 --- a/compute/pzgetrf_nopiv.c +++ b/compute/pzgetrf_nopiv.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzgram.c b/compute/pzgram.c index 3218b1a78757b8ef7802837ff5fe224bff6403ff..6a3cc069b48af32928e8d9c75e1f6781c8d5de18 100644 --- a/compute/pzgram.c +++ b/compute/pzgram.c @@ -2,17 +2,17 @@ * * @file pzgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-10 + * @date 2020-03-03 * @precisions normal z -> s d c z * */ diff --git a/compute/pzhemm.c b/compute/pzhemm.c index 4339b77ff1458dc1d565ae1a4719fa73b7f2161a..51aed5f17b8b172fd32be8aba2434efae75a8454 100644 --- a/compute/pzhemm.c +++ b/compute/pzhemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/pzher2k.c b/compute/pzher2k.c index 8e2cb085cd394c15d6220c97675f9e77a6f3f3e3..45eb07198ddd6ee045025270e50f5736fd1ba1ef 100644 --- a/compute/pzher2k.c +++ b/compute/pzher2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/pzherk.c b/compute/pzherk.c index bd3fa544100ec378763c66ca6ce852c5edf13f8c..42e4e1fa3ad4c85df9602280792b75e0b30218eb 100644 --- a/compute/pzherk.c +++ b/compute/pzherk.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/pzhetrd_he2hb.c b/compute/pzhetrd_he2hb.c index 8ebd19da5c7efc00082eb7e14f48e21b53e439c3..4edc26a7a656835e7345994607847fb7635a0ba3 100644 --- a/compute/pzhetrd_he2hb.c +++ b/compute/pzhetrd_he2hb.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhetrd_he2hb parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlacpy.c b/compute/pzlacpy.c index 397b122b5298fc9999945be1fadd15bffd173027..646a35a75beb805836e1e01eddf2f2b8b4c65db7 100644 --- a/compute/pzlacpy.c +++ b/compute/pzlacpy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlag2c.c b/compute/pzlag2c.c index b574b2a3370715eadc40c6b4972cfb6e3b7e245b..8fd7119d9f46656430e1b913c9500865131c89bb 100644 --- a/compute/pzlag2c.c +++ b/compute/pzlag2c.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlag2c parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/compute/pzlange.c b/compute/pzlange.c index a0b6a6d90faa23ddb98cf5354300f34573b513cd..d44069a6702d6878e1f855ee3738cae2db2d369f 100644 --- a/compute/pzlange.c +++ b/compute/pzlange.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Emmanuel Agullo * @author Mathieu Faverge * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlansy.c b/compute/pzlansy.c index 7698ed3899f08e7b9337491226caffc90854345f..fece76c386e81dd2fed4df352ce382e83cd91e76 100644 --- a/compute/pzlansy.c +++ b/compute/pzlansy.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Emmanuel Agullo * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/compute/pzlascal.c b/compute/pzlascal.c index 15c81af25faaf89ee1ba38c8a99cb123e5b3a776..d6c00bb85d2f36d6fd4aeec5f4a3d9bac556e51d 100644 --- a/compute/pzlascal.c +++ b/compute/pzlascal.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Dalal Sukkari - * @date 2016-11-30 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlaset.c b/compute/pzlaset.c index 02fd03af9b2ac03cb6cf9c91efeaa14e1c2cb814..ca54d05171a0ba7dd2b6206b711ce077a9e0c386 100644 --- a/compute/pzlaset.c +++ b/compute/pzlaset.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlaset2.c b/compute/pzlaset2.c index 8fb02e425c8426e9814696e48d40027691761280..95da88a9e676352844829d6ac9f20ae743cb5351 100644 --- a/compute/pzlaset2.c +++ b/compute/pzlaset2.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset2 parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzlauum.c b/compute/pzlauum.c index 9ad726dff6828c646cf259271d333f1f35131035..90d1e4e585aa1cb6f4bf9bb395ca01154aa0aef1 100644 --- a/compute/pzlauum.c +++ b/compute/pzlauum.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzplghe.c b/compute/pzplghe.c index e1d73ad6bbe78e3999cbc1358bbe6775d441a6bd..de18e3013acc3a8d956859be732f6d8739f12c7d 100644 --- a/compute/pzplghe.c +++ b/compute/pzplghe.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Rade Mathis * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/pzplgsy.c b/compute/pzplgsy.c index 73f05ceaf0764f15f64b248bee1765ab8468bb59..d340b2c7f98a8b747c32f2651c0aa4b4472cfdad 100644 --- a/compute/pzplgsy.c +++ b/compute/pzplgsy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Rade Mathis * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/compute/pzplrnt.c b/compute/pzplrnt.c index cbcc50a674a1c6654df7b5e8f7f76df8f2781563..90518035a852c6c07285a7ed2a8b3648d2cb8284 100644 --- a/compute/pzplrnt.c +++ b/compute/pzplrnt.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzpotrf.c b/compute/pzpotrf.c index c9c77abbf5ab8476f38a1036735b15507bf315b6..84c0cf7928ddafed1b77da141db5f0bcac441b96 100644 --- a/compute/pzpotrf.c +++ b/compute/pzpotrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzpotrimm.c b/compute/pzpotrimm.c index 7d924b9fe16a40168d55fbd8c739f0ee4c626169..f5eb40117b7dc84d4f23be0420cd5be5f064c2de 100644 --- a/compute/pzpotrimm.c +++ b/compute/pzpotrimm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrimm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief * @author Mathieu Faverge * @author Ali M Charara - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzsymm.c b/compute/pzsymm.c index d953dacf503be5cc2e3c513d0b4d43ab8647e033..fd1096ce283d57f5f3512181eccfb6f31a748962 100644 --- a/compute/pzsymm.c +++ b/compute/pzsymm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzsyr2k.c b/compute/pzsyr2k.c index c0c34cfd62605e0d85cd80c2b4115b46bbf89538..73a8eb762fcd9b8f880db3ef4d0c02f7af2b7667 100644 --- a/compute/pzsyr2k.c +++ b/compute/pzsyr2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/compute/pzsyrk.c b/compute/pzsyrk.c index 74ea7112e6ef2074568d133532e5f42256e49d92..cb599215d4189aeb076949783c79055bdc10c59a 100644 --- a/compute/pzsyrk.c +++ b/compute/pzsyrk.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzsytrf.c b/compute/pzsytrf.c index 42bced9d3db381927f2b27cf7fa75a39e60822ba..40c76ba9aa6bbb329f3705b9a72d7f0ee3b09ffa 100644 --- a/compute/pzsytrf.c +++ b/compute/pzsytrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Hatem Ltaief * @author Mathieu Faverge @@ -19,7 +19,7 @@ * @author Cedric Castagnede * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/pztile2band.c b/compute/pztile2band.c index ef9d54becc0d1dc245af56591152ceab371835bf..d2b7ba62b1c1f3a681b66550764ade45b28abd3d 100644 --- a/compute/pztile2band.c +++ b/compute/pztile2band.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztile2band parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar * @author Gregoire Pichon * @author Mathieu Faverge - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztpgqrt.c b/compute/pztpgqrt.c index 73b43d461991515c34dad9b06896f4c66960e09b..2ad2c0dab073e0e98315c158be4095ba9dead74b 100644 --- a/compute/pztpgqrt.c +++ b/compute/pztpgqrt.c @@ -4,7 +4,7 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * @copyright 2016-2018 KAUST. All rights reserved. * @@ -12,9 +12,9 @@ * * @brief Chameleon computational routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-21 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztpqrt.c b/compute/pztpqrt.c index 28effe7ca4ab72e66bd4a7ea2c770bf84b095b8e..7db7ec57e8f933323567541ca8b8efb72ce0f279 100644 --- a/compute/pztpqrt.c +++ b/compute/pztpqrt.c @@ -4,7 +4,7 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * @copyright 2016-2018 KAUST. All rights reserved. * @@ -12,9 +12,9 @@ * * @brief Chameleon computational routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztradd.c b/compute/pztradd.c index 4918f70f39b218636e44b9b2fbb6370613005776..c3867e4131eebacc9dd82ed5376177ed158035c3 100644 --- a/compute/pztradd.c +++ b/compute/pztradd.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Emmanuel Agullo * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztrmm.c b/compute/pztrmm.c index d0bddb77bd0830b786ffaf29808340cad8f28fc4..1f6cb2ae47f5b4ec7bbdba8b3cc7fe1a43438946 100644 --- a/compute/pztrmm.c +++ b/compute/pztrmm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztrsm.c b/compute/pztrsm.c index c6e7eac7b8433207064892f50cd3d74020776211..32599f9a505addd432e91c1e04a2c8d8cf4e8e28 100644 --- a/compute/pztrsm.c +++ b/compute/pztrsm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztrsmpl.c b/compute/pztrsmpl.c index 8a760806b734e4401b01f3192dbff4e87e62dcf6..1f79e16c0d9bf5373f0b806e0f08956cd40531f0 100644 --- a/compute/pztrsmpl.c +++ b/compute/pztrsmpl.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsmpl parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pztrtri.c b/compute/pztrtri.c index 89c1a60740f6e4ae4907fe5c00dc113fdee0e7f1..140228bd24cc5cf7c8255833b5bcfae4fb1ac965 100644 --- a/compute/pztrtri.c +++ b/compute/pztrtri.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunglq.c b/compute/pzunglq.c index 205678cb781eac775c6399d696e002a3caec0c43..8a4d71622ae7411c9357bd6cb61a512b9d652031 100644 --- a/compute/pzunglq.c +++ b/compute/pzunglq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunglq parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunglq_param.c b/compute/pzunglq_param.c index af4bfff5eb47af8ef593a9d93d65af5c647f3601..594b3e10a0be7853b266246bd324c62c2b02a49d 100644 --- a/compute/pzunglq_param.c +++ b/compute/pzunglq_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunglq_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-19 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunglqrh.c b/compute/pzunglqrh.c index 0ab0756b67e5f40c2ff215f100e1031710a57c04..a5891ece067d63ce1108495257329101cd3156c7 100644 --- a/compute/pzunglqrh.c +++ b/compute/pzunglqrh.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunglqrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Dulceneia Becker * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzungqr.c b/compute/pzungqr.c index fdccd74fe30437185fb753b6af009c59f068cbbe..4cb57ea7da8405d77880336dc644793c391d3592 100644 --- a/compute/pzungqr.c +++ b/compute/pzungqr.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zungqr parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzungqr_param.c b/compute/pzungqr_param.c index 8458b97def80e8d72016a2ffabc498f43bcf95bc..e9046ab30581d6f38e35f9514a9070fa36c89802 100644 --- a/compute/pzungqr_param.c +++ b/compute/pzungqr_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zungqr_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-05 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzungqrrh.c b/compute/pzungqrrh.c index 3e964790791a3d04b83bc93f3d90f4da5c6981b8..a2497b0a5048b56c56d81194d02f234ebf423c3d 100644 --- a/compute/pzungqrrh.c +++ b/compute/pzungqrrh.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zungqrrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmlq.c b/compute/pzunmlq.c index 0b3f109fc611659817339c8a3723fdf34f132b0b..a0ed886c27334e988642227c04faf9fbf5723a8b 100644 --- a/compute/pzunmlq.c +++ b/compute/pzunmlq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmlq_param.c b/compute/pzunmlq_param.c index 16c1c588c7981a93e1e39948e4e8199fdcbb17e9..5bf7dc05fb0e2b695aa20b01b728aa233589ba4c 100644 --- a/compute/pzunmlq_param.c +++ b/compute/pzunmlq_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-17 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmlqrh.c b/compute/pzunmlqrh.c index ee64598623793ccda1776ddd2961e254f3063bd0..8b2ea12c1b35d8c939f4ab5a9decf1def997a50f 100644 --- a/compute/pzunmlqrh.c +++ b/compute/pzunmlqrh.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlqrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmqr.c b/compute/pzunmqr.c index 333b81b17c3feeae562c8e2c474294a9957c7e84..7efcfeafeaff5ad8494d208093410e2ab7b5624d 100644 --- a/compute/pzunmqr.c +++ b/compute/pzunmqr.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmqr_param.c b/compute/pzunmqr_param.c index 8f95b49a6f4dcd053274965e764e91712aa4d27d..40455713616c968cc0ba6cc8db101872950d807c 100644 --- a/compute/pzunmqr_param.c +++ b/compute/pzunmqr_param.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr_param parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-05 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/pzunmqrrh.c b/compute/pzunmqrrh.c index 9b34176c82c0684c136a757591cc6cb9b04ff0c4..5c244a036f4fabb5a17432db1002ecd306da2366 100644 --- a/compute/pzunmqrrh.c +++ b/compute/pzunmqrrh.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqrrh parallel algorithm * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zbuild.c b/compute/zbuild.c index d50b97104eb5d1d5f648b24d593a710b7dc5d8f9..c63dfa7f0a95232c5c2ea3cbaa48ed4e4df6862f 100644 --- a/compute/zbuild.c +++ b/compute/zbuild.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon zbuild wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Guillaume Sylvand - * @date 2016-09-08 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgeadd.c b/compute/zgeadd.c index 6b2c6aa5ac19c401d046ef9ab9c50be92fdf57ec..a2baf26ce77e535b22d7baad28a1706e454cc1d2 100644 --- a/compute/zgeadd.c +++ b/compute/zgeadd.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgelqf.c b/compute/zgelqf.c index b1440bb794d718bd1e2f8ff443e189d8c2687137..52780d786712410a4b434667b7702a4c5fd90455 100644 --- a/compute/zgelqf.c +++ b/compute/zgelqf.c @@ -11,7 +11,7 @@ * * @brief Chameleon zgelqf wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgelqf_param.c b/compute/zgelqf_param.c index 8f12de563ae14a6f625bf376cb830e1f29485fb7..cb69c3e89ff4cfa233947af179db8302b51e2a6f 100644 --- a/compute/zgelqf_param.c +++ b/compute/zgelqf_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zgelqf_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-12 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgelqs.c b/compute/zgelqs.c index a6a635de5dd6c5f6d3ce74b775c8902bf52972f4..90f0ffbb7f9be1243f2a9944bfb2fc260bccffba 100644 --- a/compute/zgelqs.c +++ b/compute/zgelqs.c @@ -11,14 +11,14 @@ * * @brief Chameleon zgelqs wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgelqs_param.c b/compute/zgelqs_param.c index 7d5b48ecd33eeb354247a52235c88ba53e3bc7d0..1342ca2e7de310ed82e5e90f141853c4d2c1f57f 100644 --- a/compute/zgelqs_param.c +++ b/compute/zgelqs_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zgelqs_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Raphael Boucherie * @author Mathieu Faverge - * @date 2017-05-19 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgels.c b/compute/zgels.c index f316c01aa93d81dc9d5c95e3a5f9acb631bdb802..6fc95a6be32cbd301e1bd8d360dae698e5ae5412 100644 --- a/compute/zgels.c +++ b/compute/zgels.c @@ -11,12 +11,12 @@ * * @brief Chameleon zgels wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgels_param.c b/compute/zgels_param.c index 964f04d548be1c8315ae445a0d289df15a4e661d..3e7d677b8089fb18c652eee5b77a022fce7d0fda 100644 --- a/compute/zgels_param.c +++ b/compute/zgels_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zgels_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Raphael Boucherie * @author Mathieu Faverge - * @date 2017-05-12 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgemm.c b/compute/zgemm.c index 8fc4e8f8931d77e6c0a41e887eadb05156c979f4..92b4b667cf675912d04cd7ff409f375fa991b922 100644 --- a/compute/zgemm.c +++ b/compute/zgemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgeqrf.c b/compute/zgeqrf.c index fdf5c95753a1dfa5b8c3d04cf4981feea30d1f32..5c60f12f3c6c27d0616523daed5a31e5a46665b8 100644 --- a/compute/zgeqrf.c +++ b/compute/zgeqrf.c @@ -11,14 +11,14 @@ * * @brief Chameleon zgeqrf wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgeqrf_param.c b/compute/zgeqrf_param.c index a7899546545631ff2414338005db30213e516e43..b727316b987ac29127dbb51ab98b0516249f316f 100644 --- a/compute/zgeqrf_param.c +++ b/compute/zgeqrf_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zgeqrf_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-03 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgeqrs.c b/compute/zgeqrs.c index af9dddbd3367996cf9410d2c6056b75897198804..8721d696df785ba9529ec1cecebc86326ecd5015 100644 --- a/compute/zgeqrs.c +++ b/compute/zgeqrs.c @@ -11,14 +11,14 @@ * * @brief Chameleon zgeqrs wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgeqrs_param.c b/compute/zgeqrs_param.c index c1a61651448a267bbdfb34ed951f91468324c8a2..35d4f9174c69bb85e7cc88f9cd0117540db5a433 100644 --- a/compute/zgeqrs_param.c +++ b/compute/zgeqrs_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zgeqrs_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-12 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgesv_incpiv.c b/compute/zgesv_incpiv.c index 56909582865036d225ebc7c84a7d400d9afd5c8b..c6501fa87e70f9a102bec68b6f650361b30fe5bc 100644 --- a/compute/zgesv_incpiv.c +++ b/compute/zgesv_incpiv.c @@ -12,14 +12,14 @@ * @brief Chameleon zgesv_incpiv wrappers * Release Date: November, 15th 2009 * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgesv_nopiv.c b/compute/zgesv_nopiv.c index eceafa04967ed6f931e216a39d208e01a5ce978d..68014bb1cb313d597fbd5fa6c1a4d118373476b9 100644 --- a/compute/zgesv_nopiv.c +++ b/compute/zgesv_nopiv.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgesv_nopiv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgesvd.c b/compute/zgesvd.c index 7d12a10ba10f1f38c23f00501a5bb424bfaf6c8b..e8f754eea5a314a5ac360671f18ac7257f4bbbb2 100644 --- a/compute/zgesvd.c +++ b/compute/zgesvd.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgesvd wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Gregoire Pichon * @author Mathieu Faverge - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgetrf_incpiv.c b/compute/zgetrf_incpiv.c index f4b1b197cd64131c386973557a8fd16026c23a5e..ce6314c958058c355c886981d39c2fd7287b3779 100644 --- a/compute/zgetrf_incpiv.c +++ b/compute/zgetrf_incpiv.c @@ -11,14 +11,14 @@ * * @brief Chameleon zgetrf_incpiv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zgetrf_nopiv.c b/compute/zgetrf_nopiv.c index bbb688dec95a5cd22bc1c0c687f352b9b084a5e9..da39ad5c494e1632e403d524f295127b81f9ff82 100644 --- a/compute/zgetrf_nopiv.c +++ b/compute/zgetrf_nopiv.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * * @precisions normal z -> s d c * diff --git a/compute/zgetrs_incpiv.c b/compute/zgetrs_incpiv.c index 225cb125f7c748a49f0816d1d21ca1985df6e361..a78e08b03c2a731247eea43e8fea8136d68179b6 100644 --- a/compute/zgetrs_incpiv.c +++ b/compute/zgetrs_incpiv.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrs_incpiv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgetrs_nopiv.c b/compute/zgetrs_nopiv.c index 3a3dfe36041d3a8ba4c6f300a4d40a3072578a46..18bab0469c1f62574ee9bcdb53dad19f4a1ad89a 100644 --- a/compute/zgetrs_nopiv.c +++ b/compute/zgetrs_nopiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrs_nopiv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zgram.c b/compute/zgram.c index 602856a52cc43e427a377cef676135db1e9959b1..b3dd4a79041eadb604b484e4db836b9418b5fabc 100644 --- a/compute/zgram.c +++ b/compute/zgram.c @@ -2,17 +2,17 @@ * * @file zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-10 + * @date 2020-03-03 * @precisions normal z -> s d c z * */ diff --git a/compute/zheevd.c b/compute/zheevd.c index 9c12a00ba366d4a6080e403a995258701ebdb07b..0b654448b5808fcf2c249cb9ca0ce2431a3d9311 100644 --- a/compute/zheevd.c +++ b/compute/zheevd.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zheevd wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar * @author Hatem Ltaief - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zhemm.c b/compute/zhemm.c index 0d0c96563e9d9d10a3a52c413f05c809e0f00ed1..902a26b6df7f06687de085a68d3c9df46086b59d 100644 --- a/compute/zhemm.c +++ b/compute/zhemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zher2k.c b/compute/zher2k.c index be55713b9f92ab9fdf4da08c87f77396cb82d22d..c559c8e57faf7473842c1bc03e5f01758424df2c 100644 --- a/compute/zher2k.c +++ b/compute/zher2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zherk.c b/compute/zherk.c index 9b894f7ff17630c44ff8713fb19eb57da5fcec16..b5ded7678e134be19ade5468a0558c99855dbc88 100644 --- a/compute/zherk.c +++ b/compute/zherk.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zhetrd.c b/compute/zhetrd.c index 43c4fc59dbbc38c58f599e8edef3d8b189b73953..88ea1d77596daf0197bc68588c4ae178ad973ef6 100644 --- a/compute/zhetrd.c +++ b/compute/zhetrd.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhetrd wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar * @author Hatem Ltaief * @author Gregoire Pichon * @author Mathieu Faverge - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlacpy.c b/compute/zlacpy.c index d21b3fd09ef1a9c4612195c52ed8159419b4efef..db10f9bea16257dd5e1946c7336705efb5dd74ec 100644 --- a/compute/zlacpy.c +++ b/compute/zlacpy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlange.c b/compute/zlange.c index 6155abf4e4c338091cf78054f5a41a3dd3280f76..93f8208e1d85a80d6ac7faa30429346d18f22654 100644 --- a/compute/zlange.c +++ b/compute/zlange.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlanhe.c b/compute/zlanhe.c index 3eff195d3c8e9528ac5ae7c2a31c3f0687d45c85..4b95ba6b8a37d2cb4daf36530c393094c795c216 100644 --- a/compute/zlanhe.c +++ b/compute/zlanhe.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zlansy.c b/compute/zlansy.c index bd1916bf8a898aef2e69e0ac499e76dc74ccddee..5925ec885ea2c8683bb0dc61c7a82e4da4157805 100644 --- a/compute/zlansy.c +++ b/compute/zlansy.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlantr.c b/compute/zlantr.c index 73ef52c50edf43aaf357bff5635369d50c697e84..218933528c83980b8dcbee1d933afa60a7c195c3 100644 --- a/compute/zlantr.c +++ b/compute/zlantr.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlascal.c b/compute/zlascal.c index 4aa20ab8bf63772f58e989cd693e2539bee4451a..1b65cae3c86191f7c824b2558f30e64109858f03 100644 --- a/compute/zlascal.c +++ b/compute/zlascal.c @@ -4,7 +4,7 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * @copyright 2016-2018 KAUST. All rights reserved. * @@ -12,9 +12,9 @@ * * @brief Chameleon zlascal wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Dalal Sukkari - * @date 2016-11-30 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlaset.c b/compute/zlaset.c index f0f4f3347636a3fecbffe11b9faa918ed7eaa93d..ee727a667a19c04aa475e5018e82f20495535ee6 100644 --- a/compute/zlaset.c +++ b/compute/zlaset.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zlauum.c b/compute/zlauum.c index 67951ec88af2fe06718ee624a8c524ebffcab46d..4603daef9c6b32a57eab4d33ff6ae6e0513d2c71 100644 --- a/compute/zlauum.c +++ b/compute/zlauum.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zplghe.c b/compute/zplghe.c index 3ed478a6145e2ad4531e54c30cfe0df8b07960c8..c7655bdf3090edc5e7a4b86382860ba2a531a153 100644 --- a/compute/zplghe.c +++ b/compute/zplghe.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file is a copy of zplghe.c * wich has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 @@ -20,7 +20,7 @@ * @author Cedric Castagnede * @author Rade Mathis * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zplgsy.c b/compute/zplgsy.c index ddce51f686995f731e40b3c89fde311231d92bc0..9f53e0169250ea31ba15be229d6b4354fc70f533 100644 --- a/compute/zplgsy.c +++ b/compute/zplgsy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file is a copy of zplgsy.c, * wich has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 @@ -20,7 +20,7 @@ * @author Cedric Castagnede * @author Rade Mathis * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/compute/zplrnt.c b/compute/zplrnt.c index 0e1a0e20f8068fbac3acf1c454a6a76298b62568..c0db1f6524924751f6c8d1b7e33951a5ba7992ba 100644 --- a/compute/zplrnt.c +++ b/compute/zplrnt.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zposv.c b/compute/zposv.c index 317f21f14f21a68ea5d740e60e142ae2ca1f6100..05c2ceaf85dbe687bb41a55c7634e081afd369ee 100644 --- a/compute/zposv.c +++ b/compute/zposv.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zposv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zpotrf.c b/compute/zpotrf.c index 974312ddf660297bb08e151a305667c9734764fe..20f5170456dd76d784783223f3416e9bd9174eda 100644 --- a/compute/zpotrf.c +++ b/compute/zpotrf.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zpotri.c b/compute/zpotri.c index 899e13b8951cf70b461ff7aaeaad4bc8d97bcd8a..db5d27eb0d891e3772035abc9f1c6e369d9a689e 100644 --- a/compute/zpotri.c +++ b/compute/zpotri.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotri wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zpotrimm.c b/compute/zpotrimm.c index 7d5cda488829fc32ee1d6bebed2689cfe473cca1..ffc22c47703944e312b988dce5f35ba8222fc1c5 100644 --- a/compute/zpotrimm.c +++ b/compute/zpotrimm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrimm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zpotrs.c b/compute/zpotrs.c index 1d290f64f197b08fa76911060f3978e5ddc6e143..2fd02e9d50b815ad5ecb7136bf77bf17aaa3a1a3 100644 --- a/compute/zpotrs.c +++ b/compute/zpotrs.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrs wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zsymm.c b/compute/zsymm.c index 6adfb945aeaeede508dc110928ef7cbc7ec0e26e..e489388ec12809c31d0c79d99366fe7c3786a078 100644 --- a/compute/zsymm.c +++ b/compute/zsymm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zsyr2k.c b/compute/zsyr2k.c index 73c79dd1800100d24bdbb7277d5e6e413b9f581e..7d0ade7ae02e561c85013e3380ebe19456caa8ae 100644 --- a/compute/zsyr2k.c +++ b/compute/zsyr2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/compute/zsyrk.c b/compute/zsyrk.c index 85963b6a91442a4d135a6b54802b2bb42149ccfd..b052fd4352af4e25477e450603ddbafd9fdcc494 100644 --- a/compute/zsyrk.c +++ b/compute/zsyrk.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zsysv.c b/compute/zsysv.c index ebee2c6f13de6b154a371c1f04bb9fc484a1c019..d1790017bb91941dd568a5fcfa28d2e2e5fb9fe0 100644 --- a/compute/zsysv.c +++ b/compute/zsysv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsysv wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Cedric Castagnede * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zsytrf.c b/compute/zsytrf.c index b603ddde5224e523317fc9580eb9eb87b1704080..54b7538b83babd0f49a888343ae35b851a9a61ee 100644 --- a/compute/zsytrf.c +++ b/compute/zsytrf.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/zsytrs.c b/compute/zsytrs.c index 84a2c778fc1bcf36bfe843a6194ec6cab27ad373..a6694af12b3b0330fb800582b822d2160850b15a 100644 --- a/compute/zsytrs.c +++ b/compute/zsytrs.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrs wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Cedric Castagnede * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/compute/ztile.c b/compute/ztile.c index 580f520d6c247265be34d6207a2e38e04a7ac795..02af3dfb8e41ff40fa207662203be81491760e89 100644 --- a/compute/ztile.c +++ b/compute/ztile.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon auxiliary routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztpgqrt.c b/compute/ztpgqrt.c index 41c89e69e1179a9885d64f348cab0d4ae8d11734..28b572f6e940db194ff63671a22e00f2873cc770 100644 --- a/compute/ztpgqrt.c +++ b/compute/ztpgqrt.c @@ -12,9 +12,9 @@ * * @brief Chameleon ztpgqrt wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-21 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/ztpqrt.c b/compute/ztpqrt.c index 742960d20599d44efdbd78e8aa339a0791e9b2d9..8d7713451a8c14b112da08530b2d97d05e99395a 100644 --- a/compute/ztpqrt.c +++ b/compute/ztpqrt.c @@ -4,7 +4,7 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * @copyright 2016-2018 KAUST. All rights reserved. * @@ -12,9 +12,9 @@ * * @brief Chameleon ztpqrt wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztradd.c b/compute/ztradd.c index 0b1700a15b454c5af7834706983eb3a89f753d3f..330c2ebb9f7abfdaac5f78fa1428c0e300669f26 100644 --- a/compute/ztradd.c +++ b/compute/ztradd.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztrmm.c b/compute/ztrmm.c index 09399a3b51e38f1443ef6832d3198ffea2033279..257fcf2e8131794c1306e54294bd49f3edd1da19 100644 --- a/compute/ztrmm.c +++ b/compute/ztrmm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztrsm.c b/compute/ztrsm.c index cb9edbf88b217c26e038c0d10f0062a7f1208369..71f320132177b2f7cda155a2b3d5d174c1132411 100644 --- a/compute/ztrsm.c +++ b/compute/ztrsm.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztrsmpl.c b/compute/ztrsmpl.c index 8ed5145a90c4b2c4e6cbe4887cd3f952844bcf35..f897260288668851ed7f168f0b1c6e67e48c6c34 100644 --- a/compute/ztrsmpl.c +++ b/compute/ztrsmpl.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsmpl wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/ztrtri.c b/compute/ztrtri.c index 56a0c948507a4dbc3861041e9d555cac0743f62e..194795b96b00d41dfa1e6867fe6a464d27b185ae 100644 --- a/compute/ztrtri.c +++ b/compute/ztrtri.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/compute/zunglq.c b/compute/zunglq.c index 552fe9f5709ea42f6c7ccd3f905b7b09b4ac7c07..6222017546d0b0731d896bf85599cde34f842b6d 100644 --- a/compute/zunglq.c +++ b/compute/zunglq.c @@ -11,7 +11,7 @@ * * @brief Chameleon zunglq wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zunglq_param.c b/compute/zunglq_param.c index fa4c16c3777fba00330eec9bef37edc2a2507e33..d381ee71678dc1e8ee1bbeeb23e3cd94f7a2cbc5 100644 --- a/compute/zunglq_param.c +++ b/compute/zunglq_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zunglq_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-19 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zungqr.c b/compute/zungqr.c index 20c0d6d35ae9b5e22b45504354c5ab1e4766084d..213afe017cf2d9b81a61cb1b5f0b24211c2b4356 100644 --- a/compute/zungqr.c +++ b/compute/zungqr.c @@ -11,7 +11,7 @@ * * @brief Chameleon zungqr wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zungqr_param.c b/compute/zungqr_param.c index edc69caaf5f1bb0d03e4f59dbabb144053275139..47785cc20631235af9c998425804501153cebecc 100644 --- a/compute/zungqr_param.c +++ b/compute/zungqr_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zungqr_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-05 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zunmlq.c b/compute/zunmlq.c index 2dbc905542e971caa3b1b0967d9b3487f637b313..9c30790b3689ec0be3651638165c046988cf891a 100644 --- a/compute/zunmlq.c +++ b/compute/zunmlq.c @@ -11,7 +11,7 @@ * * @brief Chameleon zunmlq wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zunmlq_param.c b/compute/zunmlq_param.c index 408d1b24225c4cd4d5f16265f2f22c737a0b0be8..bdda9683d67c59eb7f20c34a3601881a17071e61 100644 --- a/compute/zunmlq_param.c +++ b/compute/zunmlq_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zunmlq_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-17 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zunmqr.c b/compute/zunmqr.c index 15adf30ef74d87369936d1db8c9239b110604e68..dc78364b335622a32114cf5a5a309a369fce54cd 100644 --- a/compute/zunmqr.c +++ b/compute/zunmqr.c @@ -11,7 +11,7 @@ * * @brief Chameleon zunmqr wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/compute/zunmqr_param.c b/compute/zunmqr_param.c index 36bf757e27138ae4c1911dd35752f574a359ee66..5308e91053fede8c23bb138034c0b0ac68d58931 100644 --- a/compute/zunmqr_param.c +++ b/compute/zunmqr_param.c @@ -11,10 +11,10 @@ * * @brief Chameleon zunmqr_param wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Raphael Boucherie - * @date 2017-05-05 + * @date 2020-01-07 * @precisions normal z -> s d c * */ diff --git a/control/CMakeLists.txt b/control/CMakeLists.txt index 377ddb77f0798d5af74324a99e655ffc0118d21d..5fa3f22ec0aa951a8720a94daa85deb8228b61e3 100644 --- a/control/CMakeLists.txt +++ b/control/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/control/async.c b/control/async.c index 47685fbb785c9fa9f125cd61df809dc180e3be66..06157246736c0d4ae1629e0e36195f0d0ff77e2c 100644 --- a/control/async.c +++ b/control/async.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon asynchronous management routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/async.h b/control/async.h index f900ff4e5daf5c1bfd2ddf48413f91f89138b9ed..be521ae68f37c12ea0859f0f0bb77295f43e3fa6 100644 --- a/control/async.h +++ b/control/async.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon asynchronous management header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _chameleon_async_h_ diff --git a/control/auxiliary.c b/control/auxiliary.c index 8f767222c39788744adacde3012b125e04ce2221..a311acd6505e92f87d96edb8fce1972a06454643 100644 --- a/control/auxiliary.c +++ b/control/auxiliary.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon auxiliary routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Piotr Luszczek * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/auxiliary.h b/control/auxiliary.h index 44e23675b32a07d529e59e23ae3eeeaee9886a21..f024b7f8bf45618aeb69af93868dcdfe6a693afa 100644 --- a/control/auxiliary.h +++ b/control/auxiliary.h @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon auxiliary header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Piotr Luszczek * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _chameleon_auxiliary_h_ diff --git a/control/chameleon_f77.c b/control/chameleon_f77.c index eb70cf98f018c8be612b4d57711607b0ef86e969..7de2fe850557b483ab887d19cd95b951d572b34e 100644 --- a/control/chameleon_f77.c +++ b/control/chameleon_f77.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Fortran77 interface * - * @version 0.9.2 + * @version 1.0.0 * @author Bilel Hadri * @author Cedric Castagnede * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/control/chameleon_f77.h b/control/chameleon_f77.h index e4bace01e0e341863ce22c126420e319fb033eb0..e7a4abc833715ded6c7ab6c6dc04c66073acd184 100644 --- a/control/chameleon_f77.h +++ b/control/chameleon_f77.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Fortran77 naming macros * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _chameleon_f77_h_ diff --git a/control/chameleon_f90.f90 b/control/chameleon_f90.f90 index 152e00431ada6ccdac8285fe994e4f294d6fac20..db2b926fc274cb9fcace33d9478eed42e3e31042 100644 --- a/control/chameleon_f90.f90 +++ b/control/chameleon_f90.f90 @@ -6,12 +6,12 @@ ! CHAMELEON is a software package provided by Univ. of Tennessee, ! Univ. of California Berkeley and Univ. of Colorado Denver ! -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Numerical Algorithm Group -! @date 2018-07-12 +! @date 2020-03-03 ! ! -- Inria ! -- (C) Copyright 2012 diff --git a/control/chameleon_mf77.c b/control/chameleon_mf77.c index 359eb1be7ce8538d492be9831216078344e1e37e..44eabee331c3ccde7fe2d433a75aa34807e86334 100644 --- a/control/chameleon_mf77.c +++ b/control/chameleon_mf77.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Fortran77 interface for mixed-precision computational routines * - * @version 0.9.2 + * @version 1.0.0 * @author Bilel Hadri * @author Cedric Castagnede - * @date 2018-07-12 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/control/chameleon_zcf90.F90 b/control/chameleon_zcf90.F90 index 7bde298455e336f1338db1614f6a3a553c8786f8..b100656f511d46c0173ef43042504c6edd1bf55d 100644 --- a/control/chameleon_zcf90.F90 +++ b/control/chameleon_zcf90.F90 @@ -6,15 +6,15 @@ ! CHAMELEON is a software package provided by Univ. of Tennessee, ! Univ. of California Berkeley and Univ. of Colorado Denver ! -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Numerical Algorithm Group ! @author Mathieu Faverge ! @author Emmanuel Agullo ! @author Cedric Castagnede -! @date 2018-07-12 +! @date 2020-03-03 ! @precisions mixed zc -> ds ! ! -- Inria diff --git a/control/chameleon_zf77.c b/control/chameleon_zf77.c index a6ad73c881943b618e31834ce9bcf9152ae79947..6162950adc36ea39555323e6eab694c8e15b640b 100644 --- a/control/chameleon_zf77.c +++ b/control/chameleon_zf77.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Fortran77 computational routines * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @comment This file is automatically generated by tools/genf77interface.pl @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/control/chameleon_zf90.F90 b/control/chameleon_zf90.F90 index 60380e94f0d30de2a26d853f3e57ca70f278c2e3..447c82a9723c9a3fef4d0cfbe0c778f0c278c88b 100644 --- a/control/chameleon_zf90.F90 +++ b/control/chameleon_zf90.F90 @@ -6,15 +6,15 @@ ! CHAMELEON is a software package provided by Univ. of Tennessee, ! Univ. of California Berkeley and Univ. of Colorado Denver ! -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Numerical Algorithm Group ! @author Mathieu Faverge ! @author Emmanuel Agullo ! @author Cedric Castagnede -! @date 2018-07-12 +! @date 2020-03-03 ! @precisions normal z -> c d s ! ! -- Inria diff --git a/control/chameleon_zf90_wrappers.F90 b/control/chameleon_zf90_wrappers.F90 index 56928b3b9a5ff8cbeeaaa6462d6a46ca95620aa3..c061f553c9c343687015378e25c7e0ea7249a723 100644 --- a/control/chameleon_zf90_wrappers.F90 +++ b/control/chameleon_zf90_wrappers.F90 @@ -6,15 +6,15 @@ ! CHAMELEON is a software package provided by Univ. of Tennessee, ! Univ. of California Berkeley and Univ. of Colorado Denver ! -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Numerical Algorithm Group ! @author Mathieu Faverge ! @author Emmanuel Agullo ! @author Cedric Castagnede -! @date 2018-07-12 +! @date 2020-03-03 ! @precisions normal z -> c d s ! ! diff --git a/control/common.h b/control/common.h index a22c99f89427cf04fbdcefdad6510a9ac88c5428..82e84ece1a8b41cace8e62945497fd67eaac714c 100644 --- a/control/common.h +++ b/control/common.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon common header file * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ /** diff --git a/control/compute_z.h b/control/compute_z.h index 7f7903d04d1b97646ad88ea294592e0374872508..06b023fb20aba468ef8e5cd40c9b504bcc10a1d9 100644 --- a/control/compute_z.h +++ b/control/compute_z.h @@ -11,14 +11,14 @@ * * @brief Chameleon computational functions header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-01-07 * @precisions normal z -> c d s * */ diff --git a/control/context.c b/control/context.c index 759716782288ffce5a375cb3c3fd048aef8527ed..358f28ea9391232073f441fad273a9e79c3be9c8 100644 --- a/control/context.c +++ b/control/context.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon context management routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/context.h b/control/context.h index 379d953c0c7d665547019d120c8c1283bd3539f9..1bdeed556e13f30e7f165ee4a696d46931917982 100644 --- a/control/context.h +++ b/control/context.h @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon context header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _chameleon_context_h_ diff --git a/control/control.c b/control/control.c index d000550b635f950ff7fd2270033380dd8a0f0d07..604eb1901cd257d68a4012675a0359a860cf8a40 100644 --- a/control/control.c +++ b/control/control.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon control routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/descriptor.c b/control/descriptor.c index 3df1e6766a307741a76f806bec4b5042de487224..8c8ac0c67b0e3844ff5ea575fec8e618975fca76 100644 --- a/control/descriptor.c +++ b/control/descriptor.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon descriptors routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/descriptor.h b/control/descriptor.h index b4d8832d0e376a34c3384d71ab868b97f1b27bfc..ee92a35cfc34b9022ee8310a421fdcbce085a799 100644 --- a/control/descriptor.h +++ b/control/descriptor.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon descriptor header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _chameleon_descriptor_h_ diff --git a/control/gkkleader.h b/control/gkkleader.h index 3171cdb275a86ca47887dc142732e2fd4a5944e1..291dd6d6a844149e90b361458d62a7edf66139f1 100644 --- a/control/gkkleader.h +++ b/control/gkkleader.h @@ -4,15 +4,15 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon InPlaceTransformation main module header - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * * This work is the implementation of an inplace transformation * based on the GKK algorithm by Gustavson, Karlsson, Kagstrom diff --git a/control/global.h b/control/global.h index d00a71fd06a5fcfd8db16384ee1be1c63624a7ec..75d9fd31de1cc55f3a1548321687ecf881b77a78 100644 --- a/control/global.h +++ b/control/global.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon global variables header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Piotr Luszczek * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ /** diff --git a/control/primes.h b/control/primes.h index c1f71ab7dfffd65b21ce46d3ed3201ca012b203f..dc27b2a6dbc06fc5948b453bdf15f9c447d2ca94 100644 --- a/control/primes.h +++ b/control/primes.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon InPlaceTransformation prime numbers module header - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * * This work is the implementation of an inplace transformation * based on the GKK algorithm by Gustavson, Karlsson, Kagstrom diff --git a/control/tile.c b/control/tile.c index 74c498cb35a0157bc062b46c926f4981f033ed7a..c32b0355a38018b3e519aac491530084a514573e 100644 --- a/control/tile.c +++ b/control/tile.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon layout conversion wrappers * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/workspace.c b/control/workspace.c index 52fb945ab041d03441f1081a22a83cb6094c2bdb..6689d394806d381c63defd98d63e6663ea1f5514 100644 --- a/control/workspace.c +++ b/control/workspace.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon workspace routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * *** * diff --git a/control/workspace.h b/control/workspace.h index a98a8a7524888a861821ee7fbe5167e1862cdf37..efed5ad5415359725499d733e747d0a2a6d9a903 100644 --- a/control/workspace.h +++ b/control/workspace.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon workspace header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _chameleon_workspace_h_ diff --git a/control/workspace_z.c b/control/workspace_z.c index d4c832401e8e0e9fb9e034ab834ddec29bf8e9fc..c7bb4e12ee1e715019435b65a17620d3f79b3d0d 100644 --- a/control/workspace_z.c +++ b/control/workspace_z.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon precision dependent workspace routines * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/CMakeLists.txt b/coreblas/CMakeLists.txt index 63d59d009c5d50f84c127c65105d57222400b44f..aefee37d119bc3149f8a52e562cd20ee72efbc00 100644 --- a/coreblas/CMakeLists.txt +++ b/coreblas/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/coreblas/compute/CMakeLists.txt b/coreblas/compute/CMakeLists.txt index e85b36fa5ed57637225dedfb7f47c0c3518dff19..120c4ff72cf1ee545489a4864079e1735fd55f69 100644 --- a/coreblas/compute/CMakeLists.txt +++ b/coreblas/compute/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/coreblas/compute/core_dzasum.c b/coreblas/compute/core_dzasum.c index 74b6f870509cea81d70b15b9591d368275a98b46..e8ad8e5c00ac3cc2ab5dd4356bda4850d0685bfd 100644 --- a/coreblas/compute/core_dzasum.c +++ b/coreblas/compute/core_dzasum.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_dzasum CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zaxpy.c b/coreblas/compute/core_zaxpy.c index b2b48780299c76952f7dca1c7285643b5fec3d03..8c73d0dce28b2bd5b974cba951d0b9501e8c88fd 100644 --- a/coreblas/compute/core_zaxpy.c +++ b/coreblas/compute/core_zaxpy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgeadd.c b/coreblas/compute/core_zgeadd.c index a7def06bbe7094ef4a84816062e3035890c6cc9c..b48dd567d3909a1bc281be383aec7e2f1258d337 100644 --- a/coreblas/compute/core_zgeadd.c +++ b/coreblas/compute/core_zgeadd.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgeadd CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgelqt.c b/coreblas/compute/core_zgelqt.c index dd1595de17006c71a8ddd14fc1e2a826a17addd0..3117c35786b5b47a72e7d666547836eeaf634341 100644 --- a/coreblas/compute/core_zgelqt.c +++ b/coreblas/compute/core_zgelqt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgelqt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgemm.c b/coreblas/compute/core_zgemm.c index ac225182cac1593bf4e00c2d2db115753f9a3096..ee03bb7926be45e164743abc83207d6be3d8234d 100644 --- a/coreblas/compute/core_zgemm.c +++ b/coreblas/compute/core_zgemm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgemm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgeqrt.c b/coreblas/compute/core_zgeqrt.c index 2173815e8c483bc95fcc3d0a39d893a47d586daa..233466eeccc6ecd3ee3a5e4cde957190daaf32c0 100644 --- a/coreblas/compute/core_zgeqrt.c +++ b/coreblas/compute/core_zgeqrt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgeqrt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgesplit.c b/coreblas/compute/core_zgesplit.c index ad9cd06664484c487317e7f835cb140691fe8bf8..840c3ce7f5ee7afa4305113bc819ef3d8ab89a51 100644 --- a/coreblas/compute/core_zgesplit.c +++ b/coreblas/compute/core_zgesplit.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgesplit CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgessm.c b/coreblas/compute/core_zgessm.c index 418e6b21911bd39303e550ab41ba62130c5f01cf..9af8009f489b234583262179dd52b782e3a72e60 100644 --- a/coreblas/compute/core_zgessm.c +++ b/coreblas/compute/core_zgessm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgessm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgessq.c b/coreblas/compute/core_zgessq.c index 8b02bb10ae9a69b8e5742f176a26dd2ea9142d1f..bcacc4c971fb008058275febb9b2eeaf69e9b7b6 100644 --- a/coreblas/compute/core_zgessq.c +++ b/coreblas/compute/core_zgessq.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgessq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgetf2_nopiv.c b/coreblas/compute/core_zgetf2_nopiv.c index f2235b3d612f0e89d80ca8b39dc30a3fd567d903..de127b42d114e98848090d2b7a70ff65bc15aaca 100644 --- a/coreblas/compute/core_zgetf2_nopiv.c +++ b/coreblas/compute/core_zgetf2_nopiv.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgetf2_nopiv CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgetrf.c b/coreblas/compute/core_zgetrf.c index 59b41ec76fc1d81f21e8276a0a58e65943bd8f0e..6863aa6fdb04e804b9ed5b0c1b561f7c63a333e2 100644 --- a/coreblas/compute/core_zgetrf.c +++ b/coreblas/compute/core_zgetrf.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgetrf CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgetrf_incpiv.c b/coreblas/compute/core_zgetrf_incpiv.c index 98dd5c9223592696b1de87871eafa4b3b870f59b..08b42cccea14993037e8746672d1e9322347ed8e 100644 --- a/coreblas/compute/core_zgetrf_incpiv.c +++ b/coreblas/compute/core_zgetrf_incpiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgetrf_incpiv CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgetrf_nopiv.c b/coreblas/compute/core_zgetrf_nopiv.c index 1b8e4f58d0ff78aa7fad14b4ea3bc887ff8551c4..b4c2ea79f5b2d1463c65b9c29968259d597d8b44 100644 --- a/coreblas/compute/core_zgetrf_nopiv.c +++ b/coreblas/compute/core_zgetrf_nopiv.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgetrf_nopiv CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zgram.c b/coreblas/compute/core_zgram.c index 56881ebde58a0514503caacaf74394eb0080c1e0..f4d7fabe8a296bcaf73b781898801e0068f733b6 100644 --- a/coreblas/compute/core_zgram.c +++ b/coreblas/compute/core_zgram.c @@ -2,17 +2,17 @@ * * @file core_zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zgram CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-10 + * @date 2020-03-03 * @precisions normal z -> s d c z * */ diff --git a/coreblas/compute/core_zhe2ge.c b/coreblas/compute/core_zhe2ge.c index d2cf0827a5e6b349cb6bdcaeab1c2fb0a5581c5c..c110cd64faebd782c41cfbe49269908802cf3bf2 100644 --- a/coreblas/compute/core_zhe2ge.c +++ b/coreblas/compute/core_zhe2ge.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zhe2ge CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zhemm.c b/coreblas/compute/core_zhemm.c index 75efaa7182e120754db5e733b2b2158baf79f117..c05939c05da533754bb03cbdc5b9942a2e06dfb2 100644 --- a/coreblas/compute/core_zhemm.c +++ b/coreblas/compute/core_zhemm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zhemm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zher2k.c b/coreblas/compute/core_zher2k.c index a8c9c8acc95e65182ea96cc42296eedcac0d5051..39a1225d4ed11dca5a0e02c860bcf795dd94add5 100644 --- a/coreblas/compute/core_zher2k.c +++ b/coreblas/compute/core_zher2k.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zher2k CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zherfb.c b/coreblas/compute/core_zherfb.c index a54de4a5aaec39def2aa98b11ae250bc8dff96f4..92e704029262edf562aa92352ed5108793171db1 100644 --- a/coreblas/compute/core_zherfb.c +++ b/coreblas/compute/core_zherfb.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zherfb CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zherk.c b/coreblas/compute/core_zherk.c index a53d69e882b22ae4d35246cb3828542f3b9cfd02..de31abc81bb2f3c077c441c35ba2c9a4824889c1 100644 --- a/coreblas/compute/core_zherk.c +++ b/coreblas/compute/core_zherk.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zherk CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zhessq.c b/coreblas/compute/core_zhessq.c index 255e7e7f716f6b2cd3475c11aefac373814a2ae8..f419762187eed5d76eab595d66c5e5d0a57d9b63 100644 --- a/coreblas/compute/core_zhessq.c +++ b/coreblas/compute/core_zhessq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zhessq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zlacpy.c b/coreblas/compute/core_zlacpy.c index 40ed5423636f9469fb367e1aa78b0c729e213c65..3d73b552d3e192744090b5a593ad74b34c5f836f 100644 --- a/coreblas/compute/core_zlacpy.c +++ b/coreblas/compute/core_zlacpy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlacpy CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlag2c.c b/coreblas/compute/core_zlag2c.c index b954f888e743bb0b4028c0bd1fd8181c4700976d..d8e71310610b274e49a1272e2c9e23c6cc60581e 100644 --- a/coreblas/compute/core_zlag2c.c +++ b/coreblas/compute/core_zlag2c.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlag2c CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/coreblas/compute/core_zlange.c b/coreblas/compute/core_zlange.c index 0baf34546cb61d850baaaf92ba1f3464271b2bd4..9cb868c0b25c945b3c5bdcb75753d922131f8be8 100644 --- a/coreblas/compute/core_zlange.c +++ b/coreblas/compute/core_zlange.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlange CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlanhe.c b/coreblas/compute/core_zlanhe.c index a57b29bc029a46c8312f4d0a4202fbe5d5ba2bc9..5254b4210713a84d3dac20bfdc0a6de13746eed0 100644 --- a/coreblas/compute/core_zlanhe.c +++ b/coreblas/compute/core_zlanhe.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlanhe CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zlansy.c b/coreblas/compute/core_zlansy.c index 0cac88ba34a4147151c5f51ebe16a82c9f2e0ace..7b700c22c3d21b62cffaac1ff85a13cc79e61db3 100644 --- a/coreblas/compute/core_zlansy.c +++ b/coreblas/compute/core_zlansy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlansy CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlantr.c b/coreblas/compute/core_zlantr.c index ffecb0ee9de67a5d3fa645c5dd3c4770e852a770..d6a88c22efe62668d134fc28eb2a3f63eba9d3de 100644 --- a/coreblas/compute/core_zlantr.c +++ b/coreblas/compute/core_zlantr.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlantr CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlascal.c b/coreblas/compute/core_zlascal.c index 7c6d937d01c4457c4350ed4acec5bef0cc8336f7..ec1c7269de745c449720eda591069ff9baf0dbc9 100644 --- a/coreblas/compute/core_zlascal.c +++ b/coreblas/compute/core_zlascal.c @@ -4,7 +4,7 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * @copyright 2016-2018 KAUST. All rights reserved. * @@ -12,9 +12,9 @@ * * @brief Chameleon core_zlascal CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Dalal Sukkari - * @date 2016-11-30 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlaset.c b/coreblas/compute/core_zlaset.c index 255b111007728a90d4fed2419babf2eed1dbf7a6..841bd6031c193ddbf0254ba4a144697564be3939 100644 --- a/coreblas/compute/core_zlaset.c +++ b/coreblas/compute/core_zlaset.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlaset CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlaset2.c b/coreblas/compute/core_zlaset2.c index d7eefc8635814bca3a594735c82e6a9f03dbab1b..2dc4ff9d8de7891a4c6441117153f453d586b109 100644 --- a/coreblas/compute/core_zlaset2.c +++ b/coreblas/compute/core_zlaset2.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlaset2 CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlatro.c b/coreblas/compute/core_zlatro.c index e86b2b17c9584af4c1d2a58f37b6f32f1a01e161..421bf246fa98b9094e136a4df167f33edf8940f6 100644 --- a/coreblas/compute/core_zlatro.c +++ b/coreblas/compute/core_zlatro.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlatro CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zlauum.c b/coreblas/compute/core_zlauum.c index 4016ca79d2a19b8d1621eb6792c9c428bd048d06..3a589ab26ed418f5f972a67ad8e626da9dbb4afe 100644 --- a/coreblas/compute/core_zlauum.c +++ b/coreblas/compute/core_zlauum.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zlauum CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zpamm.c b/coreblas/compute/core_zpamm.c index 01a25ea5556a8e959d8a9e16befe070fa8ef9359..88ae05185d301f6bdb6872cb78b5c225576a0d6e 100644 --- a/coreblas/compute/core_zpamm.c +++ b/coreblas/compute/core_zpamm.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zpamm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Dulceneia Becker * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zparfb.c b/coreblas/compute/core_zparfb.c index 9bd1e809aece98394aef87d742dd68b7140f9406..22f07ca3d10fb3055996dec569fd07701e3119d8 100644 --- a/coreblas/compute/core_zparfb.c +++ b/coreblas/compute/core_zparfb.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zparfb CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Dulceneia Becker * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zpemv.c b/coreblas/compute/core_zpemv.c index 236139d238dc1fea0502b74c89c56534c2f8e040..80d1b1080a56c08cc6102af9e5b284132054a8e0 100644 --- a/coreblas/compute/core_zpemv.c +++ b/coreblas/compute/core_zpemv.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zpemv CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Dulceneia Becker * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zplghe.c b/coreblas/compute/core_zplghe.c index d6ca0bc739ee126830d96f322ecc851dfe6b3576..aa864d13a587973bf248584797300622efd86fb4 100644 --- a/coreblas/compute/core_zplghe.c +++ b/coreblas/compute/core_zplghe.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zplghe CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_zplgsy.c b/coreblas/compute/core_zplgsy.c index f92f90a8d77edab31822031785b6cf5c3eec035e..995dd20c75633f6fe2b57eb0215513efbd1f31bc 100644 --- a/coreblas/compute/core_zplgsy.c +++ b/coreblas/compute/core_zplgsy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zplgsy CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zplrnt.c b/coreblas/compute/core_zplrnt.c index 7bde0cab7cdea80db4353acdeb1f8c2b166d3bc0..b3ef3fd336719fbed9fb6e35daa6a74ed95fba1f 100644 --- a/coreblas/compute/core_zplrnt.c +++ b/coreblas/compute/core_zplrnt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zplrnt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zplssq.c b/coreblas/compute/core_zplssq.c index 4e8d8750d4dd58457cf72004e82860b3821d82a1..b5b55ddcd57093f6607a1c36de871891fe35a65e 100644 --- a/coreblas/compute/core_zplssq.c +++ b/coreblas/compute/core_zplssq.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zplssq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-01 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zpotrf.c b/coreblas/compute/core_zpotrf.c index 107cfe5fa95c59064bcfc96359d81c75e8e9e310..906a669bc8a3dd786ee3f348cfc864db422539b8 100644 --- a/coreblas/compute/core_zpotrf.c +++ b/coreblas/compute/core_zpotrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zpotrf CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zssssm.c b/coreblas/compute/core_zssssm.c index c98e80a7a7ab1f3a53e3de60a4913beffbd49cb9..125c1661f4d3bc63380eaaec52ba9a7810721de8 100644 --- a/coreblas/compute/core_zssssm.c +++ b/coreblas/compute/core_zssssm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zssssm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zsymm.c b/coreblas/compute/core_zsymm.c index 5a286dafe6559b8824582e6753a3ddb73fb7662c..1ea8fb2a9889f322df76ec1c6559a4813696d248 100644 --- a/coreblas/compute/core_zsymm.c +++ b/coreblas/compute/core_zsymm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zsymm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zsyr2k.c b/coreblas/compute/core_zsyr2k.c index 3d1771201d67390e79540c17be2201d4601802b3..84614114594bd8b0d939a5026ecd0ea94b54ca3b 100644 --- a/coreblas/compute/core_zsyr2k.c +++ b/coreblas/compute/core_zsyr2k.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zsyr2k CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zsyrk.c b/coreblas/compute/core_zsyrk.c index 4f2667144ce186906bcf2c22c8de8730583141ee..62bb449ce54a84d8ecdde2f5b97e89c916de7a8e 100644 --- a/coreblas/compute/core_zsyrk.c +++ b/coreblas/compute/core_zsyrk.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zsyrk CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zsyssq.c b/coreblas/compute/core_zsyssq.c index 0f194cfeb380390ee2aba5d19e8bbd77405aa560..848dde51cce3221983ff0d133b7d90b256111fbe 100644 --- a/coreblas/compute/core_zsyssq.c +++ b/coreblas/compute/core_zsyssq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zsyssq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zsytf2_nopiv.c b/coreblas/compute/core_zsytf2_nopiv.c index 72f65a9e9812132f7223cc93f28a459bf83bd31d..c0ee46667cbd37e50b188021520068c93dc1b839 100644 --- a/coreblas/compute/core_zsytf2_nopiv.c +++ b/coreblas/compute/core_zsytf2_nopiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zsytf2_nopiv CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -21,7 +21,7 @@ * @author Cedric Castagnede * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/coreblas/compute/core_ztile.c b/coreblas/compute/core_ztile.c index a1ff2c1839f2e05fde45ee546b2b71b6b2800144..173855a3b5bd858e80c0aaec4c823a692f2e3345 100644 --- a/coreblas/compute/core_ztile.c +++ b/coreblas/compute/core_ztile.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2018 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon CPU kernel interface from CHAM_tile_t layout to the real one. * * @version 1.0.0 * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztplqt.c b/coreblas/compute/core_ztplqt.c index c0404b076fa0a81126ffe26c6818f0abd1679bca..8e4fac20f44f2b67f0063fb249fa298d8ed403e5 100644 --- a/coreblas/compute/core_ztplqt.c +++ b/coreblas/compute/core_ztplqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztplqt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztpmlqt.c b/coreblas/compute/core_ztpmlqt.c index a15c7db3db38144f319ac7409c4b94ca4148bba2..d0ac8e83486a6d84ed1d40e205d2b118a3dfbf06 100644 --- a/coreblas/compute/core_ztpmlqt.c +++ b/coreblas/compute/core_ztpmlqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztpmlqt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztpmqrt.c b/coreblas/compute/core_ztpmqrt.c index 68dfb974437c2d702a174b71a8613be9125b4c51..92b14abf672f411dd00462b0d38cab2411fb2ffb 100644 --- a/coreblas/compute/core_ztpmqrt.c +++ b/coreblas/compute/core_ztpmqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztpmqrt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztpqrt.c b/coreblas/compute/core_ztpqrt.c index 94de0268acbf3b20b4b496480f63522760bd08d9..df25eb4aa29f2b1113bfe53b2ba454cf74cb7113 100644 --- a/coreblas/compute/core_ztpqrt.c +++ b/coreblas/compute/core_ztpqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztpqrt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztradd.c b/coreblas/compute/core_ztradd.c index f87388f4d29dede98695ce3f6cefe92e9db2a375..b4849603e938f39127b6d4c55d9f34910973e4c5 100644 --- a/coreblas/compute/core_ztradd.c +++ b/coreblas/compute/core_ztradd.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztradd CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztrasm.c b/coreblas/compute/core_ztrasm.c index 2f6e7e509bd1f5918bd116916764d2cf3c5a0d5f..0bf3f21050c5612093db4445220c0c478949b854 100644 --- a/coreblas/compute/core_ztrasm.c +++ b/coreblas/compute/core_ztrasm.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztrasm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztrmm.c b/coreblas/compute/core_ztrmm.c index ffd1410376dde2239264022fa0baf11f6229ba3f..3f706889151b89d4f000b23c6dc20c4277bc12d7 100644 --- a/coreblas/compute/core_ztrmm.c +++ b/coreblas/compute/core_ztrmm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztrmm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztrsm.c b/coreblas/compute/core_ztrsm.c index 66978a5330d49e404536f6814da585854af69688..466ed82c38f5c0f8077ea815173bee7da864bffb 100644 --- a/coreblas/compute/core_ztrsm.c +++ b/coreblas/compute/core_ztrsm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztrsm CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztrssq.c b/coreblas/compute/core_ztrssq.c index da470442a3ef02062d37ba06eb3d772cd98ef3c9..a94fad38a38dfb81681cea71f66564f37d58dd5d 100644 --- a/coreblas/compute/core_ztrssq.c +++ b/coreblas/compute/core_ztrssq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztrssq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztrtri.c b/coreblas/compute/core_ztrtri.c index 99685d722bc8f2bbc515ab89872fa97df084fb58..a081c7a145d4f788e7e15353e88381f226a39698 100644 --- a/coreblas/compute/core_ztrtri.c +++ b/coreblas/compute/core_ztrtri.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztrtri CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztslqt.c b/coreblas/compute/core_ztslqt.c index 8f5efa616180b3d3d82ef6b0071944cfb774b1b3..d58c6ccf1c56ff26bf86a8b3ac475629b4879994 100644 --- a/coreblas/compute/core_ztslqt.c +++ b/coreblas/compute/core_ztslqt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztslqt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztsmlq.c b/coreblas/compute/core_ztsmlq.c index d0f55f225b25a8a80b2042902f0b0f9f3bf375dc..3e71792d63f9f822e267e1c4a0ae58c210942145 100644 --- a/coreblas/compute/core_ztsmlq.c +++ b/coreblas/compute/core_ztsmlq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztsmlq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -21,7 +21,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztsmlq_hetra1.c b/coreblas/compute/core_ztsmlq_hetra1.c index c4e947942e6f33da0b225a1bc749016496c5e776..2fc8395c41e427645221753fcb015bd2f9cc7fed 100644 --- a/coreblas/compute/core_ztsmlq_hetra1.c +++ b/coreblas/compute/core_ztsmlq_hetra1.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztsmlq_hetra1 CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztsmqr.c b/coreblas/compute/core_ztsmqr.c index 98b5b58d0b53022794c3e645b43ab96209fbe67a..9439d32377fb9594ea875cfc3a2a317c3011a6c8 100644 --- a/coreblas/compute/core_ztsmqr.c +++ b/coreblas/compute/core_ztsmqr.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztsmqr CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -21,7 +21,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztsmqr_hetra1.c b/coreblas/compute/core_ztsmqr_hetra1.c index 2b9f8f661fa9da0eee78a1f6ca322b9a4a24c4da..238b12a2e8a3d629ee5b8f3c48fe49ca01228c5a 100644 --- a/coreblas/compute/core_ztsmqr_hetra1.c +++ b/coreblas/compute/core_ztsmqr_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztsmqr_hetra1 CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Jakub Kurzak * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztsqrt.c b/coreblas/compute/core_ztsqrt.c index 10e7cb39d4f70d9af295f0f8556bb8cacdee2708..9e6026e6526f9db67b3b359d249bc6e03d254cd6 100644 --- a/coreblas/compute/core_ztsqrt.c +++ b/coreblas/compute/core_ztsqrt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztsqrt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_ztstrf.c b/coreblas/compute/core_ztstrf.c index fbdbae98651d6fd9801b26c6c3b42f2fa6141ab8..c3bd03c1bf5a6d6474955c797aba7e1e84d4e9c5 100644 --- a/coreblas/compute/core_ztstrf.c +++ b/coreblas/compute/core_ztstrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_ztstrf CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zttlqt.c b/coreblas/compute/core_zttlqt.c index ddbad65e339f00dcad2f9a1bca561419e47d28e8..6556813c276ad749733effe916ec1adade08fbba 100644 --- a/coreblas/compute/core_zttlqt.c +++ b/coreblas/compute/core_zttlqt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zttlqt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zttmlq.c b/coreblas/compute/core_zttmlq.c index 0226f47dd3e1562bc407902d2e5d7cf6aa5f6de1..fcf3d543b7c5cdeddaf9bffcac8cfa6e47e4792a 100644 --- a/coreblas/compute/core_zttmlq.c +++ b/coreblas/compute/core_zttmlq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zttmlq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zttmqr.c b/coreblas/compute/core_zttmqr.c index e04a22ac5b22a553f85d019313a46148747a1218..72d05e2aaf0eb160fe44067e79cfb871c87c741f 100644 --- a/coreblas/compute/core_zttmqr.c +++ b/coreblas/compute/core_zttmqr.c @@ -4,13 +4,13 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. *** * * @brief Chameleon core_zttmqr CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -18,7 +18,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zttqrt.c b/coreblas/compute/core_zttqrt.c index be14098d1120bf2820620a2f7d59b5f36def630d..fc89e511f56b118070e97f6915ee7fa31eb6a284 100644 --- a/coreblas/compute/core_zttqrt.c +++ b/coreblas/compute/core_zttqrt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zttqrt CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zunmlq.c b/coreblas/compute/core_zunmlq.c index 6a310b8598349a5c6a1adf9d2c086ef5a13548eb..0ee95023476bce4bb83c792cebb714dc7f4a4df9 100644 --- a/coreblas/compute/core_zunmlq.c +++ b/coreblas/compute/core_zunmlq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_zunmlq CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/core_zunmqr.c b/coreblas/compute/core_zunmqr.c index 712da7e6c11a0c6accc01ca2418446eebb379637..b746a9440fea9463df3905d10971d0373139256c 100644 --- a/coreblas/compute/core_zunmqr.c +++ b/coreblas/compute/core_zunmqr.c @@ -4,7 +4,7 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * */ @@ -12,7 +12,7 @@ * * @brief Chameleon core_zunmqr CPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/compute/global.c b/coreblas/compute/global.c index f08c09c455b6c0c099b1e3db6e6d1bebd81fd54c..e92d078d07a4e25f985208419f7ee417b0b141b4 100644 --- a/coreblas/compute/global.c +++ b/coreblas/compute/global.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon global coreblas variables and functions * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Piotr Luszczek - * @date 2014-11-16 + * @date 2020-03-03 * */ static int coreblas_gemm3m_enabled = 0; diff --git a/coreblas/eztrace_module/CMakeLists.txt b/coreblas/eztrace_module/CMakeLists.txt index 2850ca00370764b0db7d313fe62d95f443ad495f..084d8e4eb24206ac34b94ce5d69427d832d82245 100644 --- a/coreblas/eztrace_module/CMakeLists.txt +++ b/coreblas/eztrace_module/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,9 +17,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2015-09-15 +# @date 2020-03-03 # ### diff --git a/coreblas/include/CMakeLists.txt b/coreblas/include/CMakeLists.txt index 3d77e2b03817ccb0bd7833d70757fc4bf70692e7..414b4fe82214424d329b8ae6c90ffde147ea07cf 100644 --- a/coreblas/include/CMakeLists.txt +++ b/coreblas/include/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/coreblas/include/coreblas.h b/coreblas/include/coreblas.h index bf4db17eae59eeb2fcffe012aa05c71b5c1aaf4a..703b17382b9f60d8791af57482cb02e5bf3f66fa 100644 --- a/coreblas/include/coreblas.h +++ b/coreblas/include/coreblas.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CPU kernels main header * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Hatem Ltaief - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _coreblas_h_ diff --git a/coreblas/include/coreblas/cblas.h b/coreblas/include/coreblas/cblas.h index fdfd5595ad848f742f74e58903c3332b15a8df74..03a65b893043302239c4f00a2eba309c46d69025 100644 --- a/coreblas/include/coreblas/cblas.h +++ b/coreblas/include/coreblas/cblas.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cblas header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Castagnede - * @date 2012-09-15 + * @date 2020-03-03 * */ #ifndef _cblas_h_ diff --git a/coreblas/include/coreblas/coreblas_z.h b/coreblas/include/coreblas/coreblas_z.h index ee9e3e0d88269259812b5b97f2c5f8a4c9d40972..4db2c94f130367fab69d7429eee4ef384da8a1c9 100644 --- a/coreblas/include/coreblas/coreblas_z.h +++ b/coreblas/include/coreblas/coreblas_z.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CPU CHAMELEON_Complex64_t kernels header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2017-07-29 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/include/coreblas/coreblas_zc.h b/coreblas/include/coreblas/coreblas_zc.h index d6b81491da1bfbbebcf6652e54eac38a86069392..7b9956738c4fecce447fcbb7dc15aaa0d349053f 100644 --- a/coreblas/include/coreblas/coreblas_zc.h +++ b/coreblas/include/coreblas/coreblas_zc.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CPU complex mixed precision kernels header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2017-07-29 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/coreblas/include/coreblas/coreblas_ztile.h b/coreblas/include/coreblas/coreblas_ztile.h index f26e3cbeee1251739b94f5cca6f756e8dd78e8be..b5de9f7667d56514c583919f94f52e6a2798ff3a 100644 --- a/coreblas/include/coreblas/coreblas_ztile.h +++ b/coreblas/include/coreblas/coreblas_ztile.h @@ -2,14 +2,14 @@ * * @file coreblas_ztile.h * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800 ), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800 ), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon CPU kernel CHAM_tile_t interface * * @version 1.0.0 * @author Mathieu Faverge - * @date 2019-08-01 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/coreblas/include/coreblas/lapacke_config.h b/coreblas/include/coreblas/lapacke_config.h index 4ef15ef7cf253b15eb23c0f6223be079c3c83ce4..cc41b681550a0aa10c1ae2e47a4340c31258b581 100644 --- a/coreblas/include/coreblas/lapacke_config.h +++ b/coreblas/include/coreblas/lapacke_config.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon lapacke configuration header * - * @version 0.9.2 + * @version 1.0.0 * */ /** diff --git a/coreblas/include/coreblas/lapacke_mangling.h b/coreblas/include/coreblas/lapacke_mangling.h index 725153cce9b51d992b7ff183c1b1f511f298c03a..e8ecfc6ccdbe4e6fe927d07c7b5ec95218ab24c2 100644 --- a/coreblas/include/coreblas/lapacke_mangling.h +++ b/coreblas/include/coreblas/lapacke_mangling.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon lapacke mangling header * - * @version 0.9.2 + * @version 1.0.0 * */ #ifndef _lapacke_mangling_h_ diff --git a/coreblas/include/coreblas/sumsq_update.h b/coreblas/include/coreblas/sumsq_update.h index c5312e9e3a084d94ed589f37b5e8842cf208038b..aef065d16fdb5f355c65b6ee46bdbe82e198d9fc 100644 --- a/coreblas/include/coreblas/sumsq_update.h +++ b/coreblas/include/coreblas/sumsq_update.h @@ -2,16 +2,16 @@ * * @file sumsq_update.h * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CPU auxiliary sumsq_update routine * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2019-03-27 + * @date 2020-03-03 * */ #ifndef _sumsq_update_h_ diff --git a/cudablas/CMakeLists.txt b/cudablas/CMakeLists.txt index d792c223c1eb52d8d532f24670347b428cb09b36..aefee37d119bc3149f8a52e562cd20ee72efbc00 100644 --- a/cudablas/CMakeLists.txt +++ b/cudablas/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2015-09-17 +# @date 2020-03-03 # ### diff --git a/cudablas/compute/CMakeLists.txt b/cudablas/compute/CMakeLists.txt index d322c92370e4c7ebe105db37d98377cbae5fcf85..5d05dc015d8ffd843e13d74a68c07bdefe749107 100644 --- a/cudablas/compute/CMakeLists.txt +++ b/cudablas/compute/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,9 +17,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2015-09-17 +# @date 2020-03-03 # ### diff --git a/cudablas/compute/cuda_zgeadd.c b/cudablas/compute/cuda_zgeadd.c index 0f22536623f6418a3bdae1d83af51b66b3519152..dc558e72b309a0c757bc30ca26a25fabef736f51 100644 --- a/cudablas/compute/cuda_zgeadd.c +++ b/cudablas/compute/cuda_zgeadd.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgeadd GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2017-04-10 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgelqt.c b/cudablas/compute/cuda_zgelqt.c index 9ad274cc0eb3ec14a1b2a5e04470fae867014412..abc5bc834d06d4a9d1df0fd5205e25e94bb77923 100644 --- a/cudablas/compute/cuda_zgelqt.c +++ b/cudablas/compute/cuda_zgelqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgelqt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgemerge.c b/cudablas/compute/cuda_zgemerge.c index cfa018d5608e92cd5e52a5d8d8ea3574486c6b42..33bffb28943ba220b2b6529000f6b0e237f8c3aa 100644 --- a/cudablas/compute/cuda_zgemerge.c +++ b/cudablas/compute/cuda_zgemerge.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgemerge GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgemm.c b/cudablas/compute/cuda_zgemm.c index 2c174a9e5d41ef2bab968edbdde485841df28ab8..c4352084238ac0dc571d1d566d0eb27ad8cdf309 100644 --- a/cudablas/compute/cuda_zgemm.c +++ b/cudablas/compute/cuda_zgemm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgemm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgeqrt.c b/cudablas/compute/cuda_zgeqrt.c index 386fa01263ff4ebe4dea5e128d80e618529a83ec..0c35b546c6881a00b8e9a97352c4ecf1b94eda70 100644 --- a/cudablas/compute/cuda_zgeqrt.c +++ b/cudablas/compute/cuda_zgeqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgeqrt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgessm.c b/cudablas/compute/cuda_zgessm.c index aeed0dcbd611f4b1c70860e56eb6ed383afd2901..54d656cf5542e7e6f0ee2996fb279e72b8e22b78 100644 --- a/cudablas/compute/cuda_zgessm.c +++ b/cudablas/compute/cuda_zgessm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgessm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zgetrf.c b/cudablas/compute/cuda_zgetrf.c index a6a46d8a6d15fa11f6f3eb4052514a65a239869a..ae4b10d85a55c749209d1c9fa5f9bc11ecff7f28 100644 --- a/cudablas/compute/cuda_zgetrf.c +++ b/cudablas/compute/cuda_zgetrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zgetrf GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zhemm.c b/cudablas/compute/cuda_zhemm.c index 1338d1e259fc9d01c06bd0dbf61e5feaa42d3d40..9d86481165a367a6b2b6d6f5a7a436bd1ba9e81c 100644 --- a/cudablas/compute/cuda_zhemm.c +++ b/cudablas/compute/cuda_zhemm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zhemm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/cudablas/compute/cuda_zher2k.c b/cudablas/compute/cuda_zher2k.c index 48893e0f590aa435db75b3f3b857dc36ac995742..d4b305f314d4f330978f632ff21d30492734bee4 100644 --- a/cudablas/compute/cuda_zher2k.c +++ b/cudablas/compute/cuda_zher2k.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zher2k GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/cudablas/compute/cuda_zherfb.c b/cudablas/compute/cuda_zherfb.c index ae54c28ac5b13a4b79025fe0bdd60023b0d96ec6..731773a88b9da7de9b5a03d94608abcf72d2f0a2 100644 --- a/cudablas/compute/cuda_zherfb.c +++ b/cudablas/compute/cuda_zherfb.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zherfb GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2016-12-22 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zherk.c b/cudablas/compute/cuda_zherk.c index e78b8316927455334e443bc408398c0911b371ab..1bdf6f179bed44f005af3a2089d327040eb362f0 100644 --- a/cudablas/compute/cuda_zherk.c +++ b/cudablas/compute/cuda_zherk.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zherk GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/cudablas/compute/cuda_zlarfb.c b/cudablas/compute/cuda_zlarfb.c index b34b9df87e66c7125cb14e0cd7b7a4542337c316..b19caa2363d5d30643b2e33a0c69385e5edb759c 100644 --- a/cudablas/compute/cuda_zlarfb.c +++ b/cudablas/compute/cuda_zlarfb.c @@ -4,7 +4,7 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** @@ -13,9 +13,9 @@ * * Code originated from MAGMA * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2016-12-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zlauum.c b/cudablas/compute/cuda_zlauum.c index f112f39ec6c91039360cd0a26edb78b363968d08..82c5ede0b64bedaa16c1b349eef169a7b49afbf5 100644 --- a/cudablas/compute/cuda_zlauum.c +++ b/cudablas/compute/cuda_zlauum.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zlauum GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zparfb.c b/cudablas/compute/cuda_zparfb.c index b4e6f6c1944bdf83878a428a456f0340257ec7a2..331190f6955aeeed283d40733db2067b916c8187 100644 --- a/cudablas/compute/cuda_zparfb.c +++ b/cudablas/compute/cuda_zparfb.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zparfb GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zpotrf.c b/cudablas/compute/cuda_zpotrf.c index 895fda836d115285314e91d192aab809ee2b0a4a..0702102af2186451bd499db91ddfb470186bce77 100644 --- a/cudablas/compute/cuda_zpotrf.c +++ b/cudablas/compute/cuda_zpotrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zpotrf GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zssssm.c b/cudablas/compute/cuda_zssssm.c index bd7bc2014a6cbb58414a0dd9b2e2dd3f89ff24bf..8a4d4487fce5e7eceb4b0cd4dfac13d404b72c71 100644 --- a/cudablas/compute/cuda_zssssm.c +++ b/cudablas/compute/cuda_zssssm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zssssm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zsymm.c b/cudablas/compute/cuda_zsymm.c index 64321a3575d6591e048524aba07fe805c47f4e2e..dcbe05bf1e85e0d319d9cf3890f23c2f70adbd85 100644 --- a/cudablas/compute/cuda_zsymm.c +++ b/cudablas/compute/cuda_zsymm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zsymm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zsyr2k.c b/cudablas/compute/cuda_zsyr2k.c index 3ccf9262c6dcf0877fe9118d2a79f5c8e319e033..70b7d3c1d84da594faa742408c5151cd0a4e42e2 100644 --- a/cudablas/compute/cuda_zsyr2k.c +++ b/cudablas/compute/cuda_zsyr2k.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zsyr2k GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zsyrk.c b/cudablas/compute/cuda_zsyrk.c index a205568bcf511a0c46062c0b392f85f7ab788e6a..a699800bd1021dc686d130c9d920e5bdc4669061 100644 --- a/cudablas/compute/cuda_zsyrk.c +++ b/cudablas/compute/cuda_zsyrk.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zsyrk GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztpmlqt.c b/cudablas/compute/cuda_ztpmlqt.c index aaf70c231cd59ebee4762cb62d3529b52beabfcc..64e556e800aca2534f83eeca0eb2dbb9c3f737f6 100644 --- a/cudablas/compute/cuda_ztpmlqt.c +++ b/cudablas/compute/cuda_ztpmlqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztpmlqt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-11-07 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztpmqrt.c b/cudablas/compute/cuda_ztpmqrt.c index c9a1fea2a8b524be4cf4f29af44dbf8b42e87f78..1b8c198467cc4dd952c0479bdbe0e3267ae7abd6 100644 --- a/cudablas/compute/cuda_ztpmqrt.c +++ b/cudablas/compute/cuda_ztpmqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztpmqrt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2016-12-22 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztrmm.c b/cudablas/compute/cuda_ztrmm.c index aa95a42f7281c074c8d1b0954e6bdea496373cf0..43dbef20b2fbb7dd329ec341ecfb8505c9d15055 100644 --- a/cudablas/compute/cuda_ztrmm.c +++ b/cudablas/compute/cuda_ztrmm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztrmm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztrsm.c b/cudablas/compute/cuda_ztrsm.c index 2c49aafb1df971cd205e515d19df82095d291d36..d5ac5356b01a0741ac87b2b17b1e265ae59bf4bb 100644 --- a/cudablas/compute/cuda_ztrsm.c +++ b/cudablas/compute/cuda_ztrsm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztrsm GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztrtri.c b/cudablas/compute/cuda_ztrtri.c index 849c169e6f0355ed92399e426c17eadbf8f397ba..5bca5a18987d2b7e05e4ff121cd4f147d3e2de81 100644 --- a/cudablas/compute/cuda_ztrtri.c +++ b/cudablas/compute/cuda_ztrtri.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztrtri GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztslqt.c b/cudablas/compute/cuda_ztslqt.c index 1aced8402f879e3aad813f97ae25791f48c1c6b6..609d8b584c4339551179d7c115404f904dcf7496 100644 --- a/cudablas/compute/cuda_ztslqt.c +++ b/cudablas/compute/cuda_ztslqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztslqt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztsmlq.c b/cudablas/compute/cuda_ztsmlq.c index c0ec9683a549176f8bbb56a5da0963052712d2bc..674a6518f1833f016e463eda7acafc218c776cf6 100644 --- a/cudablas/compute/cuda_ztsmlq.c +++ b/cudablas/compute/cuda_ztsmlq.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztsmlq GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Mathieu Faverge - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztsmqr.c b/cudablas/compute/cuda_ztsmqr.c index 9d533a121c0337714f159359e48f457001058294..5921cd185abab090a4b2b68e3deff70730f97d64 100644 --- a/cudablas/compute/cuda_ztsmqr.c +++ b/cudablas/compute/cuda_ztsmqr.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztsmqr GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Mathieu Faverge - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztsqrt.c b/cudablas/compute/cuda_ztsqrt.c index 50cafaaa13e349d576db5e9b50f1ebeb3d5e40a1..b1d9a2c0adcfe0e75a524f9061c0c06f5fc730fe 100644 --- a/cudablas/compute/cuda_ztsqrt.c +++ b/cudablas/compute/cuda_ztsqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztsqrt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_ztstrf.c b/cudablas/compute/cuda_ztstrf.c index 054d3bffff655849dac2c65229fb18f10f141756..4a754a93372eef6b727d973fd48206da1501884d 100644 --- a/cudablas/compute/cuda_ztstrf.c +++ b/cudablas/compute/cuda_ztstrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_ztstrf GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zttmlq.c b/cudablas/compute/cuda_zttmlq.c index b325aa8f52df0ec353af5c4e7993b809df17271c..36eaeee24c5132dfc7dd1bf66b7c3d696e4fa221 100644 --- a/cudablas/compute/cuda_zttmlq.c +++ b/cudablas/compute/cuda_zttmlq.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zttmlq GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Mathieu Faverge - * @date 2018-11-07 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zttmqr.c b/cudablas/compute/cuda_zttmqr.c index 7f283bc798387fde193e98876e61ace9e507f642..6889904f4774eb72479109fd78f9e730eb8d694b 100644 --- a/cudablas/compute/cuda_zttmqr.c +++ b/cudablas/compute/cuda_zttmqr.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zttmqr GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Mathieu Faverge - * @date 2017-04-05 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zunmlqt.c b/cudablas/compute/cuda_zunmlqt.c index a9def036b16f0733047324f0959fbd7b7079536d..7f42324a443eb5c881b5e503dc6f5fced6167633 100644 --- a/cudablas/compute/cuda_zunmlqt.c +++ b/cudablas/compute/cuda_zunmlqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zunmlqt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cuda_zunmqrt.c b/cudablas/compute/cuda_zunmqrt.c index 0686a3eb1be9c01822d0a18c464962ea830c3b8b..ef33cbd76a7757500a844e706c7161543cb14b28 100644 --- a/cudablas/compute/cuda_zunmqrt.c +++ b/cudablas/compute/cuda_zunmqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon cuda_zunmqrt GPU kernel * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/compute/cudaglobal.c b/cudablas/compute/cudaglobal.c index 2fe7d583f3b35fbe1a8af3d1d78a689c079b64f9..f41f6fb3acaafd0d656d2d41718f3290df5b8761 100644 --- a/cudablas/compute/cudaglobal.c +++ b/cudablas/compute/cudaglobal.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon global cudablas variables and functions * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2017-04-07 + * @date 2020-03-03 * */ #include "cudablas.h" diff --git a/cudablas/eztrace_module/CMakeLists.txt b/cudablas/eztrace_module/CMakeLists.txt index 85ddba60ef1daf378d696118a2070907bacf66ce..ebed8f169a1330ac19f5a3cf304986eda1a5c4f8 100644 --- a/cudablas/eztrace_module/CMakeLists.txt +++ b/cudablas/eztrace_module/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,9 +17,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2015-09-17 +# @date 2020-03-03 # ### diff --git a/cudablas/include/CMakeLists.txt b/cudablas/include/CMakeLists.txt index 4fced885aef5f9d3c67154ec5a6f530ab9dbe1b2..c69276a16ca1566dfc9bc18c78993742b366869c 100644 --- a/cudablas/include/CMakeLists.txt +++ b/cudablas/include/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,9 +17,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2015-09-17 +# @date 2020-03-03 # ### diff --git a/cudablas/include/cudablas.h b/cudablas/include/cudablas.h index 95c2bb9b2b994301e4f053758010658613ae5c90..2d324eb4f84dce8cf8dc5d0a1232fc68ccd6d3e8 100644 --- a/cudablas/include/cudablas.h +++ b/cudablas/include/cudablas.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon GPU kernels main header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-09-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/cudablas/include/cudablas/cudablas_z.h b/cudablas/include/cudablas/cudablas_z.h index 398637a6c12f8d09999cba981a79dc3abbf9a199..89a6e7ece4b6ae4dabc7fe3129f21da8bb52c579 100644 --- a/cudablas/include/cudablas/cudablas_z.h +++ b/cudablas/include/cudablas/cudablas_z.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon GPU CHAMELEON_Complex64_t kernels header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2017-07-29 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/doc/CMakeLists.txt b/doc/CMakeLists.txt index 26f32e1fbcbfddc4847b1144f5ead5fddcef5f8d..785c71fe1f9076adbee330ff9d3ba6863880064a 100644 --- a/doc/CMakeLists.txt +++ b/doc/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2012-07-13 +# @date 2020-03-03 # ### diff --git a/doc/doxygen/CMakeLists.txt b/doc/doxygen/CMakeLists.txt index cdc95310eb030308ba8328a54e4b1e26e34c78f3..989efb8a616cb9782788471acb01c290f32f2731 100644 --- a/doc/doxygen/CMakeLists.txt +++ b/doc/doxygen/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2018-10-17 +# @date 2020-03-03 # ### diff --git a/doc/doxygen/conf.dox.in b/doc/doxygen/conf.dox.in index 76f34f393fc38b2f477c1907fa5cb8e92b1422e6..fbd4553685ffdbe9b076727347841d46001b1400 100644 --- a/doc/doxygen/conf.dox.in +++ b/doc/doxygen/conf.dox.in @@ -743,7 +743,7 @@ REFERENCES_LINK_SOURCE = YES # will point to the HTML generated by the htags(1) tool instead of doxygen # built-in source browser. The htags tool is part of GNU's global source # tagging system (see http://www.gnu.org/software/global/global.html). You -# will need version 4.8.6 or higher. +# will need version 1.0.0 or higher. USE_HTAGS = NO diff --git a/doc/doxygen/main.dox b/doc/doxygen/main.dox index 4db1bf4667957e092250e0186c12189693882ef6..12edd52c1eeb12f176220318f4ec5453d1df1200 100644 --- a/doc/doxygen/main.dox +++ b/doc/doxygen/main.dox @@ -58,7 +58,7 @@ functions to control the overall process, see \ref sec_auxiliary @section sec_src_code_structure Libraries and source code organization Chameleon's project is made of some C libraries and executables whose -compilation is optional (examples, testing and timing). +compilation is optional (examples and testing). The libraries are organized as follows : @@ -116,9 +116,7 @@ algorithms into chameleon's ones - __simucore__ : data to be able to simulate chameleon executions through StarPU+SimGrid -- __testing__ : source files for testing executables (test features) - -- __timing__ : source files for timing executables (test performances) +- __testing__ : source files for testing executables (timing and numerical checks) - __tools__ : other scripts for testing (software development quality) diff --git a/doc/orgmode/CMakeLists.txt b/doc/orgmode/CMakeLists.txt index c733b5cae5b9c73a0e6738a4c588d3ce00822483..c85509772b39c4dd1f1b53d37c1e139634791c5c 100644 --- a/doc/orgmode/CMakeLists.txt +++ b/doc/orgmode/CMakeLists.txt @@ -14,9 +14,9 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2017-08-25 +# @date 2019-03-20 # ### diff --git a/doc/orgmode/chapters/installing.org b/doc/orgmode/chapters/installing.org index 52e7a23e112c64cbcfce9daab2aa4380a97bf8ca..468b55e806242ce0a3f4027dc5f61ffcfef6b16b 100644 --- a/doc/orgmode/chapters/installing.org +++ b/doc/orgmode/chapters/installing.org @@ -107,7 +107,7 @@ we encourage users to use [[sec:spack][Spack]]. 1) we need the lapacke interface to tmg routines and symbol like ~LAPACKE_dlatms_work~ should be defined in the lapacke library. The Debian packages /libopenblas-dev/ and /liblapacke-dev/ - (version 3.7.1) do not provide the tmg interface. Please update + (version 1.0.0) do not provide the tmg interface. Please update your distribution or install the lapacke interface library in another way, by yourself from source or with [[https://gitlab.inria.fr/solverstack/spack-repo][Spack]], ... 2) sometimes parallel make with -j can fails due to undefined @@ -397,7 +397,7 @@ we encourage users to use [[sec:spack][Spack]]. mpiexec -np 4 $STARPU/lib/starpu/mpi/comm # test chameleon CHAMELEON=`pkg-config --variable=prefix chameleon` - mpiexec -np 2 $CHAMELEON/bin/new-testing/snew-testing -H -o gemm -P 2 -t 2 -m 2000 -n 2000 -k 2000 + mpiexec -np 2 $CHAMELEON/bin/chameleon_stesting -H -o gemm -P 2 -t 2 -m 2000 -n 2000 -k 2000 #+end_src *** Generate a Chameleon Singularity image with Guix @@ -415,7 +415,7 @@ we encourage users to use [[sec:spack][Spack]]. called as follows #+begin_src sh # at least openmpi and singularity are required here, e.g. module add openmpi singularity - mpiexec -np 2 singularity exec chameleon-pack.gz.squashfs /bin/new-testing/snew-testing -H -o gemm -P 2 -t 2 -m 2000 -n 2000 -k 2000 + mpiexec -np 2 singularity exec chameleon-pack.gz.squashfs /bin/chameleon_stesting -H -o gemm -P 2 -t 2 -m 2000 -n 2000 -k 2000 #+end_src ** Distribution of Chameleon using Spack @@ -504,8 +504,7 @@ we encourage users to use [[sec:spack][Spack]]. make # do not hesitate to use -j[ncores] option to speedup the compilation #+end_src - 3. test (optional, required CHAMELEON_ENABLE_TESTING=ON and/or - CHAMELEON_ENABLE_TIMING=ON): + 3. test (optional, required CHAMELEON_ENABLE_TESTING=ON): #+begin_src make test # or @@ -598,10 +597,7 @@ we encourage users to use [[sec:spack][Spack]]. sub-directory * *CHAMELEON_ENABLE_PRUNING_STATS=ON|OFF* (default OFF) * *CHAMELEON_ENABLE_TESTING=ON|OFF* (default ON): to control build - of testing executables (numerical check) contained in testing/ - sub-directory - * *CHAMELEON_ENABLE_TIMING=ON|OFF* (default ON): to control build - of timing executables (performances check) contained in timing/ + of testing executables (timer and numerical check) contained in testing/ sub-directory * *CHAMELEON_SIMULATION=ON|OFF* (default OFF): to enable simulation mode, means Chameleon will not really execute tasks, diff --git a/doc/orgmode/chapters/using.org b/doc/orgmode/chapters/using.org index 9798c5831c273e9f0cce6d0ec8b6a0ee1e409ea2..25f8cf200c78fe67dee74aad4ee2c0f43f495552 100644 --- a/doc/orgmode/chapters/using.org +++ b/doc/orgmode/chapters/using.org @@ -12,122 +12,55 @@ sub-directory ~lapack_to_chameleon/~ provides a tutorial that explains how to use Chameleon functionalities starting from a full LAPACK code, see [[sec:tuto][Tutorial LAPACK to Chameleon]] - * *testing*: contains testing drivers to check numerical correctness of - Chameleon linear algebra routines with a wide range of parameters - #+begin_src - ./testing/stesting 4 1 LANGE 600 100 700 - #+end_src - Two first arguments are the number of cores and gpus to use. - The third one is the name of the algorithm to test. - The other arguments depend on the algorithm, here it lies for the number of - rows, columns and leading dimension of the problem. - - Name of algorithms available for testing are: - * LANGE: norms of matrices Infinite, One, Max, Frobenius - * GEMM: general matrix-matrix multiply - * HEMM: hermitian matrix-matrix multiply - * HERK: hermitian matrix-matrix rank k update - * HER2K: hermitian matrix-matrix rank 2k update - * SYMM: symmetric matrix-matrix multiply - * SYRK: symmetric matrix-matrix rank k update - * SYR2K: symmetric matrix-matrix rank 2k update - * PEMV: matrix-vector multiply with pentadiagonal matrix - * TRMM: triangular matrix-matrix multiply - * TRSM: triangular solve, multiple rhs - * POSV: solve linear systems with symmetric positive-definite matrix - * GESV_INCPIV: solve linear systems with general matrix - * GELS: linear least squares with general matrix - * GELS_HQR: gels with hierarchical tree - * GELS_SYSTOLIC: gels with systolic tree - * *timing*: contains timing drivers to assess performances of - Chameleon routines. There are two sets of executables, those who - do not use the tile interface and those who do (with _tile in the - name of the executable). Executables without tile interface - allocates data following LAPACK conventions and these data can be - given as arguments to Chameleon routines as you would do with - LAPACK. Executables with tile interface generate directly the - data in the format Chameleon tile algorithms used to submit tasks - to the runtime system. Executables with tile interface should be - more performant because no data copy from LAPACK matrix layout to - tile matrix layout are necessary. Calling example: - #+begin_src - ./timing/time_dpotrf --n_range=1000:10000:1000 --nb=320 - --threads=9 --gpus=3 - --nowarmup - #+end_src - - List of main options that can be used in timing: - * ~--help~: Show usage - * Machine parameters - * ~-t x, --threads=x~: Number of CPU workers (default: automatic - detection through runtime) - * ~-g x, --gpus=x~: Number of GPU workers (default: ~0~) - * ~-P x, --P=x~: Rows (P) in the PxQ process grid (default: ~1~) - * ~--nocpu~: All GPU kernels are exclusively executed on GPUs - * Matrix parameters - * ~-m x, --m=X, --M=x~: Dimension (M) of the matrices (default: - ~N~) - * ~-n x, --n=X, --N=x~: Dimension (N) of the matrices - * ~-N R, --n_range=R~: Range of N values to time with - ~R=Start:Stop:Step~ (default: ~500:5000:500~) - * ~-k x, --k=x, --K=x, --nrhs=x~: Dimension (K) of the matrices - or number of right-hand size (default: ~1~). This is useful for - GEMM algorithms (k is the shared dimension and must be defined - >1 to consider matrices and not vectors) - * ~-b x, --nb=x~: NB size. (default: ~320~) - * ~-i x, --ib=x~: IB size. (default: ~32~) - * Check/prints - * ~--niter=X~: Number of iterations performed for each test - (default: ~1~) - * ~-W, --nowarning~: Do not show warnings - * ~-w, --nowarmup~: Cancel the warmup run to pre-load libraries - * ~-c, --check~: Check result - * ~-C, --inc~: Check on inverse - * ~--mode=x~ : Change the xLATMS matrix mode generation for - SVD/EVD (default: ~4~). It must be between 0 and 20 included. - * Profiling parameters - * ~-T, --trace~: Enable trace generation - * ~--progress~: Display progress indicator - * ~-d, --dag~: Enable DAG generation. Generates a dot_dag_file.dot. - * ~-p, --profile~: Print profiling informations - * HQR parameters - * ~-a x, --qr_a=x, --rhblk=x~: Define the size of the local TS - trees in housholder reduction trees for QR and LQ - factorization. N is the size of each subdomain (default: ~-1~) - * ~-l x, --llvl=x~: Tree used for low level reduction inside - nodes (default: ~-1~) - * ~-L x, --hlvl=x~: Tree used for high level reduction between - nodes, only if P > 1 (default: ~-1~). Possible values are -1: - Automatic, 0: Flat, 1: Greedy, 2: Fibonacci, 3: Binary, 4: - Replicated greedy. - * ~-D, --domino~: Enable the domino between upper and lower trees - * Advanced options - * ~--nobigmat~: Disable single large matrix allocation for - multiple tiled allocations - * ~-s, --sync~: Enable synchronous calls in wrapper function such - as POTRI - * ~-o, --ooc~: Enable out-of-core (available only with StarPU) - * ~-G, --gemm3m~: Use gemm3m complex method - * ~--bound~: Compare result to area bound - - List of timing algorithms available: - * LANGE: norms of matrices - * GEMM: general matrix-matrix multiply - * TRSM: triangular solve - * POTRF: Cholesky factorization with a symmetric - positive-definite matrix - * POTRI: Cholesky inversion - * POSV: solve linear systems with symmetric positive-definite matrix - * GETRF_NOPIV: LU factorization of a general matrix using the tile LU algorithm without row pivoting - * GESV_NOPIV: solve linear system for a general matrix using the tile LU algorithm without row pivoting - * GETRF_INCPIV: LU factorization of a general matrix using the tile LU algorithm with partial tile pivoting with row interchanges - * GESV_INCPIV: solve linear system for a general matrix using the tile LU algorithm with partial tile pivoting with row interchanges matrix - * GEQRF: QR factorization of a general matrix - * GELQF: LQ factorization of a general matrix - * QEQRF_HQR: GEQRF with hierarchical tree - * QEQRS: solve linear systems using a QR factorization - * GELS: solves overdetermined or underdetermined linear systems involving a general matrix using the QR or the LQ factorization - * GESVD: general matrix singular value decomposition + * *testing*: contains testing drivers to check numerical + correctness and assess performance of Chameleon linear algebra + routines with a wide range of parameters + #+begin_src + ./testing/chameleon_stesting -H -o gemm -t 2 -m 2000 -n 2000 -k 2000 + #+end_src + + To get the list of parameters, use the ~-h~ or ~--help~ option. + #+begin_src + ./testing/chameleon_stesting -h + #+end_src + + Available algorithms for testing are: + * gels_hqr: Linear least squares with general matrix using hierarchical reduction trees + * ormlq_hqr: Q application with hierarchical reduction trees (LQ) + * orglq_hqr: Q generation with hierarchical reduction trees (LQ) + * gelqf_hqr: General LQ factorization with hierachical reduction trees + * ormqr_hqr: Q application with hierarchical reduction trees (QR) + * orgqr_hqr: Q generation with hierarchical reduction trees (QR) + * geqrf_hqr: General QR factorization with hierachical reduction trees + * gels: Linear least squares with general matrix + * ormlq: Q application (LQ) + * orglq: Q generation (LQ) + * gelqf: General LQ factorization + * ormqr: Q application (QR) + * orgqr: Q generation (QR) + * geqrf: General QR factorization + * gesv: General linear system solve (LU without pivoting) + * getrs: General triangular solve (LU without pivoting) + * getrf: General factorization (LU without pivoting) + * potri: Symmetric positive definite matrix inversion + * lauum: Trianguilar in-place matrix-matrix computation for Cholesky inversion + * trtri: Triangular matrix inversion + * posv: Symmetric positive definite linear system solve (Cholesky) + * potrs: Symmetric positive definite solve (Cholesky) + * potrf: Symmetric positive definite factorization (Cholesky) + * trsm: Triangular matrix solve + * trmm: Triangular matrix-matrix multiply + * syr2k: Symmetrix matrix-matrix rank 2k update + * syrk: Symmetrix matrix-matrix rank k update + * symm: Symmetric matrix-matrix multiply + * gemm: General matrix-matrix multiply + * lascal: General matrix scaling + * tradd: Triangular matrix-matrix addition + * geadd: General matrix-matrix addition + * lantr: Triangular matrix norm + * lansy: Symmetric matrix norm + * lange: General matrix norm + * lacpy: General matrix copy *** Execution trace using EZTrace <<sec:trace_ezt>> @@ -181,8 +114,8 @@ To generate the traces, you need to run your binary through eztrace: #+begin_src - eztrace ./dnew-testing -o gemm -n 1000 -b 200 - mpirun -np 4 eztrace ./dnew-testing -o gemm -n 1000 -b 200 -P 2 + eztrace ./chameleon_dtesting -o gemm -n 1000 -b 200 + mpirun -np 4 eztrace ./chameleon_dtesting -o gemm -n 1000 -b 200 -P 2 #+end_src Convert the binary files into a ~.trace~ file, and visualize it. @@ -206,7 +139,7 @@ #+begin_example export STARPU_FXT_PREFIX=/home/jdoe/fxt_files/ #+end_example - When executing a ~./timing/...~ Chameleon program, if it has been + When executing a ~./testing/...~ Chameleon program, if it has been enabled (StarPU compiled with FxT), the program will generate trace files in the directory $STARPU_FXT_PREFIX. diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cfabcff763de108a918f27cc846e785af4abf15f..ba3bcc056aa5016cba5a190f300af974947d187e 100755 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,8 +17,8 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 -# @date 2014-11-16 +# @version 1.0.0 +# @date 2020-03-03 # ### if (CHAMELEON_SIMULATION) diff --git a/example/lapack_to_chameleon/CMakeLists.txt b/example/lapack_to_chameleon/CMakeLists.txt index 6e8908d759ce818ee36198d475fa90878709bc65..9931b9d508e7087209ae08df92737ba246245a4c 100644 --- a/example/lapack_to_chameleon/CMakeLists.txt +++ b/example/lapack_to_chameleon/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -13,9 +13,9 @@ # CHAMELEON is a software package provided by Inria Bordeaux - Sud-Ouest, LaBRI, # University of Bordeaux, Bordeaux INP # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2018-07-12 +# @date 2020-03-03 # ### include_directories(${CMAKE_CURRENT_BINARY_DIR}) @@ -61,14 +61,14 @@ foreach(_ltm ${LTM_SOURCES}) set_property(TARGET ${_name_exe} PROPERTY LINKER_LANGUAGE Fortran) target_link_libraries(${_name_exe} ${libs_for_ltm}) install(TARGETS ${_name_exe} - DESTINATION bin/example/lapack_to_chameleon) + DESTINATION bin/chameleon/lapack_to_chameleon) endforeach() add_executable(step0 step0.c) set_property(TARGET step0 PROPERTY LINKER_LANGUAGE Fortran) target_link_libraries(step0 ${libs_for_step0}) install(TARGETS step0 - DESTINATION bin/example/lapack_to_chameleon) + DESTINATION bin/chameleon/lapack_to_chameleon) #-------- Tests --------- include(CTestLists.cmake) diff --git a/example/lapack_to_chameleon/lapack_to_chameleon.h b/example/lapack_to_chameleon/lapack_to_chameleon.h index e4a17d3e2c7e08e52843c508d94c7d9b1f1ded8f..2cfec18720c1f345300f9b41b5c445465ff1cec9 100644 --- a/example/lapack_to_chameleon/lapack_to_chameleon.h +++ b/example/lapack_to_chameleon/lapack_to_chameleon.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon examples common header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _lapack_to_chameleon_h_ diff --git a/example/lapack_to_chameleon/step0.c b/example/lapack_to_chameleon/step0.c index f974b1276b9811dab49b17aa54170b2f6b25ffa2..8eee3366816a0ef2d97da32e22aba4ecb5841984 100644 --- a/example/lapack_to_chameleon/step0.c +++ b/example/lapack_to_chameleon/step0.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step0 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step0.h" diff --git a/example/lapack_to_chameleon/step0.h b/example/lapack_to_chameleon/step0.h index 4d68834a602807fed7efb075038ebbe920b03ec8..68ecab05ef213148d7581908d152f3321b306fae 100644 --- a/example/lapack_to_chameleon/step0.h +++ b/example/lapack_to_chameleon/step0.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step0 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step0_h_ diff --git a/example/lapack_to_chameleon/step1.c b/example/lapack_to_chameleon/step1.c index 81f2a65f29b3c63ebc7a38c7fc0e65936ad5b412..ab40258aed17ae6ad04842e350fd7c8caa9b9109 100644 --- a/example/lapack_to_chameleon/step1.c +++ b/example/lapack_to_chameleon/step1.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step1 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step1.h" diff --git a/example/lapack_to_chameleon/step1.h b/example/lapack_to_chameleon/step1.h index 8baf1a118138d48d5cb7a26de596ec327376bbee..0a93d2bf2c75df811f14e3ec581b242d0495131a 100644 --- a/example/lapack_to_chameleon/step1.h +++ b/example/lapack_to_chameleon/step1.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step1 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step1_h_ diff --git a/example/lapack_to_chameleon/step2.c b/example/lapack_to_chameleon/step2.c index ea70b4e7ace01f05c8911b016bb95f2460739e13..f71c8c1d142751972c5ee740ca74459a73a0532f 100644 --- a/example/lapack_to_chameleon/step2.c +++ b/example/lapack_to_chameleon/step2.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step2 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step2.h" diff --git a/example/lapack_to_chameleon/step2.h b/example/lapack_to_chameleon/step2.h index 5183319667da1480d08da64e34ffd6d376d1a0e6..75e531553ea9fcde58a75a8100e60dd9172e5cf8 100644 --- a/example/lapack_to_chameleon/step2.h +++ b/example/lapack_to_chameleon/step2.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step2 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step2_h_ diff --git a/example/lapack_to_chameleon/step3.c b/example/lapack_to_chameleon/step3.c index 82d50f89a2f01aa49f0f8f0b747618c2f1715050..26bd6ff2e6dd9950d39773d20d96f7253cd89647 100644 --- a/example/lapack_to_chameleon/step3.c +++ b/example/lapack_to_chameleon/step3.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step3 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step3.h" diff --git a/example/lapack_to_chameleon/step3.h b/example/lapack_to_chameleon/step3.h index ca07668ba26f0dea06644d3140aa8321ee6543c4..d444878390041c44f277cfb0c0c251ddc4e426e0 100644 --- a/example/lapack_to_chameleon/step3.h +++ b/example/lapack_to_chameleon/step3.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step3 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step3_h_ diff --git a/example/lapack_to_chameleon/step4.c b/example/lapack_to_chameleon/step4.c index 88c80c5ed1dcf263b5de8ae244aa3706368cfefa..b6641b9ddc25cf28e5af6293e9439f7dc9e488a0 100644 --- a/example/lapack_to_chameleon/step4.c +++ b/example/lapack_to_chameleon/step4.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step4 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step4.h" diff --git a/example/lapack_to_chameleon/step4.h b/example/lapack_to_chameleon/step4.h index 4cbdcda49db951958166797f54315b1355456e28..cd5b2c756e7f1e9cdf468e307ab74154398da7a9 100644 --- a/example/lapack_to_chameleon/step4.h +++ b/example/lapack_to_chameleon/step4.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step4 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step4_h_ diff --git a/example/lapack_to_chameleon/step5.c b/example/lapack_to_chameleon/step5.c index 2cf37c098bc8fc9de8af5261aa77b677100e8fdf..de09b13fd0c5cc9c12f4b241d5eebb68590046a7 100644 --- a/example/lapack_to_chameleon/step5.c +++ b/example/lapack_to_chameleon/step5.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step5 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step5.h" diff --git a/example/lapack_to_chameleon/step5.h b/example/lapack_to_chameleon/step5.h index 423dfa533093f30d300dcca7a7680ea3e04b8922..2ee0811dbd857204e719c9917eaf140dfddb4640 100644 --- a/example/lapack_to_chameleon/step5.h +++ b/example/lapack_to_chameleon/step5.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step5 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step5_h_ diff --git a/example/lapack_to_chameleon/step6.c b/example/lapack_to_chameleon/step6.c index 0e2a6efca706d6c995968c5ca0a035c7de9902c5..9b9ebfe773d8e2fe4b6834d94d25f2d003dab96f 100644 --- a/example/lapack_to_chameleon/step6.c +++ b/example/lapack_to_chameleon/step6.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step6 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step6.h" diff --git a/example/lapack_to_chameleon/step6.h b/example/lapack_to_chameleon/step6.h index b309a613d622526210d6523c4dd09e7cc61fcd82..d35e8e4e809f1399d2f8ab7e15ae46aae969c627 100644 --- a/example/lapack_to_chameleon/step6.h +++ b/example/lapack_to_chameleon/step6.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step6 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step6_h_ diff --git a/example/lapack_to_chameleon/step7.c b/example/lapack_to_chameleon/step7.c index affa1876f9819beb35760a3f5cb913a2e4f669cd..d46cbcef03b4854421a34360a2e066a906283bda 100644 --- a/example/lapack_to_chameleon/step7.c +++ b/example/lapack_to_chameleon/step7.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step7 example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Guillaume Sylvand - * @date 2018-07-12 + * @date 2020-03-03 * */ #include "step7.h" diff --git a/example/lapack_to_chameleon/step7.h b/example/lapack_to_chameleon/step7.h index 910e37431298310449336e581c6482a759e29eab..dd97977bb12b4947f13b0c2079a4e03413a65f7c 100644 --- a/example/lapack_to_chameleon/step7.h +++ b/example/lapack_to_chameleon/step7.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon step7 example header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost * @author Guillaume Sylvand - * @date 2018-07-12 + * @date 2020-03-03 * */ #ifndef _step7_h_ diff --git a/example/link_chameleon/CMakeLists.txt b/example/link_chameleon/CMakeLists.txt index 89a16531dd1d675746e4b89b1730b0991f584aee..61ff4009a96d383548bdbce06022a7894c07afd5 100644 --- a/example/link_chameleon/CMakeLists.txt +++ b/example/link_chameleon/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,8 +17,8 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 -# @date 2015-01-30 +# @version 1.0.0 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 2.8) diff --git a/example/link_chameleon/link_chameleon.c b/example/link_chameleon/link_chameleon.c index c50bc204e6b9d17f001bce977054bccec00f2971..58461cbcdf1735446c8f6276baae11acf881a15c 100644 --- a/example/link_chameleon/link_chameleon.c +++ b/example/link_chameleon/link_chameleon.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon link_chameleon example * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2015-01-30 + * @date 2020-03-03 * */ #include <math.h> diff --git a/example/link_chameleon/link_chameleon.f90 b/example/link_chameleon/link_chameleon.f90 index a9a2594437edc9e6e34fbb8337efeda24dd02ccf..3d1f97e9268d2ecaa736f3347f07108cab149a21 100644 --- a/example/link_chameleon/link_chameleon.f90 +++ b/example/link_chameleon/link_chameleon.f90 @@ -6,12 +6,12 @@ ! CHAMELEON is a software package provided by Univ. of Tennessee, ! Univ. of California Berkeley and Univ. of Colorado Denver ! -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Florent Pruvost -! @date 2017-04-27 +! @date 2020-03-03 program fortran_example implicit none include 'chameleon_fortran.h' diff --git a/include/CMakeLists.txt b/include/CMakeLists.txt index 4d5f4d15d45a3402ff07f4971e5dffa885b1fcdf..fd3f13e1dac1034d31354da5fd6b67f30a2c8cb1 100644 --- a/include/CMakeLists.txt +++ b/include/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/include/chameleon.h b/include/chameleon.h index 67c0ca127fe25cb607fc35ad13429c4737c9e9cd..a66b980e876c51a9040be6761dc7bf040eace6bf 100644 --- a/include/chameleon.h +++ b/include/chameleon.h @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon main header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Cedric Castagnede * @author Florent Pruvost - * @date 2018-02-08 + * @date 2020-03-03 * */ #ifndef _chameleon_h_ diff --git a/include/chameleon/chameleon_z.h b/include/chameleon/chameleon_z.h index 60b04f38b92e36752588a2d30f2d6eeeb91408ca..928a6d3c5c8fca1d1372dbf1610861d2e23588fe 100644 --- a/include/chameleon/chameleon_z.h +++ b/include/chameleon/chameleon_z.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CHAMELEON_complex64_t wrappers * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2018-02-08 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/include/chameleon/chameleon_zc.h b/include/chameleon/chameleon_zc.h index 1febfa7e70524f6c70e7832f0b9044d9102ab295..638927f3a12c392012b6460f7e7e764215eba9e4 100644 --- a/include/chameleon/chameleon_zc.h +++ b/include/chameleon/chameleon_zc.h @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon mixed precision wrappers header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2018-02-08 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/include/chameleon/config.h.in b/include/chameleon/config.h.in index 8432d7a9346275a53a99c98e22fec5f39e42e8e1..688df8866668276dbda279cc97b070c0ae130454 100644 --- a/include/chameleon/config.h.in +++ b/include/chameleon/config.h.in @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon configuration file * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-06-15 + * @date 2020-03-03 * */ #ifndef CHAMELEON_CONFIG_H_HAS_BEEN_INCLUDED diff --git a/include/chameleon/constants.h b/include/chameleon/constants.h index f6c8b15e26264296538cc224c17781549760529f..47e45a1cbb6a37780216c82aa1284a9f587ee725 100644 --- a/include/chameleon/constants.h +++ b/include/chameleon/constants.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon global constants * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_constants_h_ diff --git a/include/chameleon/fortran.h b/include/chameleon/fortran.h index a9365b9d0a289b172114c305370ad02c3a22dd7c..ae0340ec580ba51da418d35a4d79bb8a7e4fdd72 100644 --- a/include/chameleon/fortran.h +++ b/include/chameleon/fortran.h @@ -5,14 +5,14 @@ ! ! @copyright 2009-2014 The University of Tennessee and The University of ! Tennessee Research Foundation. All rights reserved. -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +! @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, ! Univ. Bordeaux. All rights reserved. ! -! @version 0.9.2 +! @version 1.0.0 ! @author Bilel Hadri ! @author Mathieu Faverge ! @author Cedric Castagnede -! @date 2018-07-11 +! @date 2020-03-03 ! !** ! diff --git a/include/chameleon/runtime.h b/include/chameleon/runtime.h index b7de3780de09a19f201d336f904f98b217cc65aa..ce2e5b5af51243a06ad4946c1b0d818f7c1847b9 100644 --- a/include/chameleon/runtime.h +++ b/include/chameleon/runtime.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief The common runtimes API - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Cedric Castagnede - * @date 2018-02-08 + * @date 2020-03-03 * */ #ifndef _chameleon_runtime_h_ diff --git a/include/chameleon/runtime_struct.h b/include/chameleon/runtime_struct.h index 0b0dc50e6fcd2cfaefed81fd1cb138c8f42756ac..44bc95e60c87de30f330209a42cc6af1f4d7e637 100644 --- a/include/chameleon/runtime_struct.h +++ b/include/chameleon/runtime_struct.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Runtime structures * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #ifndef _chameleon_runtime_struct_h_ diff --git a/include/chameleon/simulate.h b/include/chameleon/simulate.h index 0b5d845f249e4ab9349ca966dac19c1d7b959b4f..4b93f67525d2295b750a9b074b852618657f4bfc 100644 --- a/include/chameleon/simulate.h +++ b/include/chameleon/simulate.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon SimGrid simulation header * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_simulate_h_ diff --git a/include/chameleon/struct.h b/include/chameleon/struct.h index aae3ded5ac94c722a9990d014729b833d671854a..1ac2edb55d5bd51d2fa969451d14eb0796e8536c 100644 --- a/include/chameleon/struct.h +++ b/include/chameleon/struct.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon structures * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_struct_h_ diff --git a/include/chameleon/tasks.h b/include/chameleon/tasks.h index 70b2d7b1330bbb2a20a9825b81089c8b01766a7f..901f052e49c8bb88c1185572a40e77fe1984eaa3 100644 --- a/include/chameleon/tasks.h +++ b/include/chameleon/tasks.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon elementary tasks main header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_tasks_h_ diff --git a/include/chameleon/tasks_z.h b/include/chameleon/tasks_z.h index a5dbef97567bee951f8a6324966fc1289d292e7e..6df71da4c29ef3c015f39feeace6e403738b064b 100644 --- a/include/chameleon/tasks_z.h +++ b/include/chameleon/tasks_z.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CHAMELEON_Complex64_t elementary tasks header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -20,7 +20,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2018-07-11 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/include/chameleon/tasks_zc.h b/include/chameleon/tasks_zc.h index 680e1913fdc767c5a05384eac1da8e7d01e5a4d5..cc9c87c7242ee8aba6012eb90540ce9c6b9d44ce 100644 --- a/include/chameleon/tasks_zc.h +++ b/include/chameleon/tasks_zc.h @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon complex mixed precision elementary tasks header * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Jakub Kurzak @@ -19,7 +19,7 @@ * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2018-07-11 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/include/chameleon/timer.h b/include/chameleon/timer.h index 6f877ab737b6fc8a75b41e37c0c46dea709c127d..ea020dc9abb727a2a08b44986cd990ddd2fb2dc2 100644 --- a/include/chameleon/timer.h +++ b/include/chameleon/timer.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * - * @version 0.9.2 + * @version 1.0.0 * * @brief Chameleon timer * * Provide a simple timer for examples and runtimes which do not provide their * own timer. - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_timer_h_ diff --git a/include/chameleon/types.h b/include/chameleon/types.h index 633a877822730fe5339b52af3738cb52e4bcdb1f..1cbedc7bae8fde7f8a0cf2d5bf989df47e6a558a 100644 --- a/include/chameleon/types.h +++ b/include/chameleon/types.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon basic datatypes header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-07-11 + * @date 2020-03-03 * */ #ifndef _chameleon_types_h_ diff --git a/new-testing/CMakeLists.txt b/new-testing/CMakeLists.txt deleted file mode 100644 index cafc9d720f2c6d2d8412d004c9565cf9720cf23b..0000000000000000000000000000000000000000 --- a/new-testing/CMakeLists.txt +++ /dev/null @@ -1,161 +0,0 @@ -### -# -# @file CMakeLists.txt -# -# @copyright 2009-2014 The University of Tennessee and The University of -# Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, -# Univ. Bordeaux. All rights reserved. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @author Lucas Barros de Assis -# @date 2014-11-16 -# -### - -# Generate chameleon auxiliary testing sources for all possible precisions -# -------------------------------------------------------------------- -set(NEWTESTING_HDRS_GENERATED "") -set(ZHDR - testing_zauxiliary.h - testing_zcheck.h - ) - -precisions_rules_py(NEWTESTING_HDRS_GENERATED "${ZHDR}" - PRECISIONS "s;d;c;z;ds;zc" ) - -add_custom_target(new-testing_include ALL SOURCES ${NEWTESTING_HDRS_GENERATED}) -set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};new-testing_include" CACHE INTERNAL "List of targets of sources") - -# Generate chameleon testing sources for all possible precisions -# ---------------------------------------------------------- -set(ZSRC - testing_zauxiliary.c - testing_zcheck.c - ################## - # LAPACK - ################## - #testing_zlaset.c - testing_zlacpy.c - testing_zlange.c - testing_zlanhe.c - testing_zlansy.c - testing_zlantr.c - testing_zgeadd.c - testing_ztradd.c - testing_zlascal.c - testing_zgemm.c - testing_zhemm.c - testing_zherk.c - testing_zher2k.c - testing_zsymm.c - testing_zsyrk.c - testing_zsyr2k.c - testing_ztrmm.c - testing_ztrsm.c - testing_zpotrf.c - testing_zpotrs.c - testing_zposv.c - testing_ztrtri.c - testing_zlauum.c - testing_zpotri.c - testing_zsytrf.c - testing_zsytrs.c - testing_zsysv.c - testing_zgetrf.c - testing_zgetrs.c - testing_zgesv.c - testing_zgeqrf.c - testing_zungqr.c - testing_zunmqr.c - testing_zgelqf.c - testing_zunglq.c - testing_zunmlq.c - # testing_zgeqrs.c - # testing_zgelqs.c - testing_zgels.c - testing_zgeqrf_hqr.c - testing_zungqr_hqr.c - testing_zunmqr_hqr.c - testing_zgelqf_hqr.c - testing_zunglq_hqr.c - testing_zunmlq_hqr.c - # testing_zgeqrs_hqr.c - # testing_zgelqs_hqr.c - testing_zgels_hqr.c - ) - -# Add include and link directories -# -------------------------------- -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) -include_directories(${CMAKE_CURRENT_BINARY_DIR}) - -# Define what libraries we have to link with -# ------------------------------------------ -unset(libs_for_tests) -# testing executables depend on chameleon and cblas, lapacke, mpi (already chameleon's dependencies) -list(APPEND libs_for_tests chameleon) -# message(STATUS "libs testings: ${libs_for_tests}") - -# Create one testing per precision with all files -# ----------------------------------------------- -foreach(_precision ${CHAMELEON_PRECISION} ) - - precisions_rules_py(${_precision}SRC_GENERATED "${ZSRC}" - PRECISIONS "${_precision}" ) - - add_executable(${_precision}new-testing - ${${_precision}SRC_GENERATED} - values.c - run_list.c - parameters.c - ) - add_dependencies(${_precision}new-testing - chameleon_include - control_include - new-testing_include - ) -if(NOT CHAMELEON_SIMULATION) - add_dependencies(${_precision}new-testing - coreblas_include - ) -endif(NOT CHAMELEON_SIMULATION) - set_property(TARGET ${_precision}new-testing PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(${_precision}new-testing ${libs_for_tests}) - - install(TARGETS ${_precision}new-testing - DESTINATION bin/new-testing) - -endforeach() - -# Force generation of sources -# --------------------------- -set(NEWTESTING_SRCS) -foreach(_precision ${CHAMELEON_PRECISION}) - list(APPEND NEWTESTING_SRCS ${${_precision}SRC_GENERATED}) -endforeach() -add_custom_target(new-testing_sources ALL SOURCES ${NEWTESTING_SRCS}) -set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};new-testing_sources" CACHE INTERNAL "List of targets of sources") - -#-------- Tests --------- -include(CTestLists.cmake) - -# copy input files -file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/input DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) - -### -### END CMakeLists.txt -### diff --git a/new-testing/CTestLists.cmake b/new-testing/CTestLists.cmake deleted file mode 100644 index 781ddfdac8e397fbd12f02cae137d4412c3a41d0..0000000000000000000000000000000000000000 --- a/new-testing/CTestLists.cmake +++ /dev/null @@ -1,78 +0,0 @@ -# -# Check testing/ -# -set(NP 2) # Amount of MPI processes -set(THREADS 2) # Amount of threads -set(N_GPUS 0) # Amount of graphic cards -set(TEST_CATEGORIES shm) -if (CHAMELEON_USE_MPI AND MPI_C_FOUND) - set( TEST_CATEGORIES ${TEST_CATEGORIES} mpi ) -endif() -if (CHAMELEON_USE_CUDA AND CUDA_FOUND) - set(N_GPUS 0 1) -endif() - -foreach(prec ${RP_CHAMELEON_PRECISIONS}) - set (CMD ./${prec}new-testing) - - # - # Create the list of test based on precision and runtime - # - set( TESTS lacpy lange lantr lansy ) - if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) - set( TESTS ${TESTS} lanhe ) - endif() - set( TESTS ${TESTS} - geadd tradd lascal - gemm symm syrk syr2k trmm trsm ) - if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) - set( TESTS ${TESTS} - hemm herk her2k ) - endif() - set( TESTS ${TESTS} - potrf potrs posv trtri lauum ) - if ( NOT CHAMELEON_SCHED_PARSEC ) - set( TESTS ${TESTS} potri ) - endif() - if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) - set( TESTS ${TESTS} - sytrf sytrs sysv ) - endif() - set( TESTS ${TESTS} - getrf getrs gesv - geqrf gelqf - geqrf_hqr gelqf_hqr) - if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) - set( TESTS ${TESTS} - ungqr unglq unmqr unmlq - ungqr_hqr unglq_hqr unmqr_hqr unmlq_hqr) - else() - set( TESTS ${TESTS} - orgqr orglq ormqr ormlq - orgqr_hqr orglq_hqr ormqr_hqr ormlq_hqr) - endif() - set( TESTS ${TESTS} - #geqrs gelqs - #geqrs_hqr gelqs_hqr - gels - gels_hqr ) - - foreach(cat ${TEST_CATEGORIES}) - foreach(gpus ${N_GPUS}) - - if (${gpus} EQUAL 1) - set(cat ${cat}_gpu) - endif() - - if (${cat} STREQUAL "mpi") - set (PREFIX mpiexec --bind-to none -n ${NP}) - else() - set (PREFIX "") - endif() - - foreach(_test ${TESTS}) - add_test(test_${cat}_${prec}${_test} ${PREFIX} ${CMD} -c -t ${THREADS} -g ${gpus} -P 1 -f input/${_test}.in ) - endforeach() - endforeach() - endforeach() -endforeach() diff --git a/new-testing/testing_zauxiliary.h b/new-testing/testing_zauxiliary.h deleted file mode 100644 index 7b35505f830613e3a6e1220a6bdcc784f0427957..0000000000000000000000000000000000000000 --- a/new-testing/testing_zauxiliary.h +++ /dev/null @@ -1,52 +0,0 @@ -/** - * - * @file testing_zauxiliary.h - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings header - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Cédric Castagnède - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#ifndef _testing_zauxiliary_h_ -#define _testing_zauxiliary_h_ - -#include "testings.h" - -/** - * - * Synchro for distributed computations - * - */ -#if defined(CHAMELEON_USE_MPI) -#define START_DISTRIBUTED() CHAMELEON_Distributed_start(); -#define STOP_DISTRIBUTED() CHAMELEON_Distributed_stop(); -#else -#define START_DISTRIBUTED() do {} while(0); -#define STOP_DISTRIBUTED() do {} while(0); -#endif - -/** - * - * General Macros for timing - * - */ -#define START_TIMING( _t_ ) \ - START_DISTRIBUTED(); \ - (_t_) = RUNTIME_get_time(); - -#define STOP_TIMING( _t_ ) \ - STOP_DISTRIBUTED(); \ - (_t_) = RUNTIME_get_time() - (_t_); \ - -#endif /* _testing_zauxiliary_h_ */ diff --git a/new-testing/testing_zgeadd.c b/new-testing/testing_zgeadd.c deleted file mode 100644 index bf41b265ec4e64aec90d7e326109d16ad75daf4e..0000000000000000000000000000000000000000 --- a/new-testing/testing_zgeadd.c +++ /dev/null @@ -1,133 +0,0 @@ -/** - * - * @file testing_zgeadd.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgeadd testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-06 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -static cham_fixdbl_t -flops_zgeadd( int M, int N ) -{ - cham_fixdbl_t flops = 0.; -#if defined( PRECISION_z ) || defined( PRECISION_c ) - /* 2 multiplications and 1 addition per element */ - flops = ( 2. * 6. + 2. ) * M * N; -#else - flops = ( 2. + 1. ) * M * N; -#endif - - return flops; -} - -int -testing_zgeadd( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres = 0; - int Am, An; - CHAM_desc_t *descA, *descB; - - /* Read arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? M : N ) ); - int LDB = run_arg_get_int( args, "LDB", M ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zgeadd( M, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - if ( trans != ChamNoTrans ) { - Am = N; - An = M; - } - else { - Am = M; - An = N; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); - - /* Fill the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - /* Compute the sum */ - START_TIMING( t ); - hres = CHAMELEON_zgeadd_Tile( trans, alpha, descA, beta, descB ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Check the solution */ - if ( check ) { - CHAM_desc_t *descB0 = CHAMELEON_Desc_Copy( descB, NULL ); - CHAMELEON_zplrnt_Tile( descB0, seedB ); - - hres += check_zsum( args, ChamUpperLower, trans, alpha, descA, beta, descB0, descB ); - - CHAMELEON_Desc_Destroy( &descB0 ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - - run_id++; - return hres; -} - -testing_t test_zgeadd; -const char *zgeadd_params[] = { "nb", "trans", "m", "n", "lda", "ldb", - "alpha", "beta", "seedA", "seedB", NULL }; -const char *zgeadd_output[] = { NULL }; -const char *zgeadd_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zgeadd_init( void ) __attribute__( ( constructor ) ); -void -testing_zgeadd_init( void ) -{ - test_zgeadd.name = "zgeadd"; - test_zgeadd.helper = "zgeadd"; - test_zgeadd.params = zgeadd_params; - test_zgeadd.output = zgeadd_output; - test_zgeadd.outchk = zgeadd_outchk; - test_zgeadd.params_list = "nb;P;trans;m;n;lda;ldb;alpha;beta;seedA;seedB"; - test_zgeadd.fptr = testing_zgeadd; - test_zgeadd.next = NULL; - - testing_register( &test_zgeadd ); -} diff --git a/new-testing/testing_zgels.c b/new-testing/testing_zgels.c deleted file mode 100644 index e8e5932ae69c6a0293c98dd885edebc3aa059565..0000000000000000000000000000000000000000 --- a/new-testing/testing_zgels.c +++ /dev/null @@ -1,151 +0,0 @@ -/** - * - * @file testing_zgels.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgels testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-28 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" -#include "../control/common.h" - -static cham_fixdbl_t -flops_zgels( cham_trans_t trans, int M, int N, int NRHS ) -{ - cham_fixdbl_t flops = 0.; - return flops; -} - -int -testing_zgels( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres = 0; - CHAM_desc_t *descA, *descX, *descT; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int ib = run_arg_get_int( args, "ib", 48 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int maxMN = chameleon_max( M, N ); - int NRHS = run_arg_get_int( args, "NRHS", 1 ); - int LDA = run_arg_get_int( args, "LDA", M ); - int LDB = run_arg_get_int( args, "LDB", maxMN ); - int RH = run_arg_get_int( args, "qra", 4 ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zgels( trans, M, N, NRHS ); - - /* Make sure trans is only Notrans or ConjTrans */ - trans = ( trans == ChamNoTrans ) ? trans : ChamConjTrans; - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - CHAMELEON_Set( CHAMELEON_INNER_BLOCK_SIZE, ib ); - - if ( RH > 0 ) { - CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_MODE, ChamTreeHouseholder ); - CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_SIZE, RH ); - } - else { - CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_MODE, ChamFlatHouseholder ); - } - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); - CHAMELEON_Alloc_Workspace_zgels( M, N, &descT, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descX, seedB ); - - /* Computes the solution */ - START_TIMING( t ); - hres = CHAMELEON_zgels_Tile( trans, descA, descT, descX ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - if ( check ) { - CHAM_desc_t *descA0, *descB; - CHAM_desc_t *subX, *subB; - - CHAMELEON_Desc_Create( - &descA0, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); - - CHAMELEON_zplrnt_Tile( descA0, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - if ( trans == ChamNoTrans ) { - subX = chameleon_desc_submatrix( descX, 0, 0, N, NRHS ); - subB = chameleon_desc_submatrix( descB, 0, 0, M, NRHS ); - } - else { - subX = chameleon_desc_submatrix( descX, 0, 0, M, NRHS ); - subB = chameleon_desc_submatrix( descB, 0, 0, N, NRHS ); - } - - /* Check the factorization and the residual */ - hres = check_zgels( args, trans, descA0, subX, subB ); - - CHAMELEON_Desc_Destroy( &descA0 ); - CHAMELEON_Desc_Destroy( &descB ); - - free( subB ); - free( subX ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descT ); - CHAMELEON_Desc_Destroy( &descX ); - - run_id++; - return hres; -} - -testing_t test_zgels; -const char *zgels_params[] = { "nb", "ib", "trans", "m", "n", "k", - "lda", "ldb", "qra", "seedA", "seedB", NULL }; -const char *zgels_output[] = { NULL }; -const char *zgels_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zgels_init( void ) __attribute__( ( constructor ) ); -void -testing_zgels_init( void ) -{ - test_zgels.name = "zgels"; - test_zgels.helper = "zgels"; - test_zgels.params = zgels_params; - test_zgels.output = zgels_output; - test_zgels.outchk = zgels_outchk; - test_zgels.params_list = "nb;ib;P;trans;m;n;k;lda;ldb;rh;seedA;seedB"; - test_zgels.fptr = testing_zgels; - test_zgels.next = NULL; - - testing_register( &test_zgels ); -} diff --git a/new-testing/testing_zgels_hqr.c b/new-testing/testing_zgels_hqr.c deleted file mode 100644 index 34dbdeb4fd946816305c6be3a24df0604592c850..0000000000000000000000000000000000000000 --- a/new-testing/testing_zgels_hqr.c +++ /dev/null @@ -1,161 +0,0 @@ -/** - * - * @file testing_zgels_hqr.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgels_hqr testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-28 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" -#include "../control/common.h" - -static cham_fixdbl_t -flops_zgels_hqr( cham_trans_t trans, int M, int N, int NRHS ) -{ - cham_fixdbl_t flops = 0.; - return flops; -} - -int -testing_zgels_hqr( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres = 0; - CHAM_desc_t *descA, *descX, *descTS, *descTT; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int ib = run_arg_get_int( args, "ib", 48 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int maxMN = chameleon_max( M, N ); - int NRHS = run_arg_get_int( args, "NRHS", 1 ); - int LDA = run_arg_get_int( args, "LDA", M ); - int LDB = run_arg_get_int( args, "LDB", maxMN ); - int qr_a = run_arg_get_int( args, "qra", -1 ); - int qr_p = run_arg_get_int( args, "qrp", -1 ); - int llvl = run_arg_get_int( args, "llvl", -1 ); - int hlvl = run_arg_get_int( args, "hlvl", -1 ); - int domino = run_arg_get_int( args, "domino", -1 ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zgels_hqr( trans, M, N, NRHS ); - - libhqr_tree_t qrtree; - libhqr_matrix_t matrix; - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - CHAMELEON_Set( CHAMELEON_INNER_BLOCK_SIZE, ib ); - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); - CHAMELEON_Alloc_Workspace_zgels( M, N, &descTS, P, Q ); - CHAMELEON_Alloc_Workspace_zgels( M, N, &descTT, P, Q ); - - /* Initialize matrix tree */ - matrix.mt = descTS->mt; - matrix.nt = descTS->nt; - matrix.nodes = P * Q; - matrix.p = P; - - libhqr_init_hqr( - &qrtree, ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, &matrix, llvl, hlvl, qr_a, qr_p, domino, 0 ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descX, seedB ); - - /* Computes the solution */ - START_TIMING( t ); - hres = CHAMELEON_zgels_param_Tile( &qrtree, trans, descA, descTS, descTT, descX ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - if ( check ) { - CHAM_desc_t *descA0, *descB; - CHAM_desc_t *subX, *subB; - - CHAMELEON_Desc_Create( - &descA0, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); - - CHAMELEON_zplrnt_Tile( descA0, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - if ( trans == ChamNoTrans ) { - subX = chameleon_desc_submatrix( descX, 0, 0, N, NRHS ); - subB = chameleon_desc_submatrix( descB, 0, 0, M, NRHS ); - } - else { - subX = chameleon_desc_submatrix( descX, 0, 0, M, NRHS ); - subB = chameleon_desc_submatrix( descB, 0, 0, N, NRHS ); - } - - /* Check the factorization and the residual */ - hres = check_zgels( args, trans, descA0, subX, subB ); - - CHAMELEON_Desc_Destroy( &descA0 ); - CHAMELEON_Desc_Destroy( &descB ); - - free( subB ); - free( subX ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descTS ); - CHAMELEON_Desc_Destroy( &descTT ); - CHAMELEON_Desc_Destroy( &descX ); - libhqr_finalize( &qrtree ); - - run_id++; - return hres; -} - -testing_t test_zgels_hqr; -const char *zgels_hqr_params[] = { "nb", "ib", "trans", "m", "n", "k", - "lda", "ldb", "qra", "qra", "qrp", "llvl", - "hlvl", "domino", "seedA", "seedB", NULL }; -const char *zgels_hqr_output[] = { NULL }; -const char *zgels_hqr_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zgels_hqr_init( void ) __attribute__( ( constructor ) ); -void -testing_zgels_hqr_init( void ) -{ - test_zgels_hqr.name = "zgels_hqr"; - test_zgels_hqr.helper = "zgels_hqr"; - test_zgels_hqr.params = zgels_hqr_params; - test_zgels_hqr.output = zgels_hqr_output; - test_zgels_hqr.outchk = zgels_hqr_outchk; - test_zgels_hqr.params_list = - "nb;ib;P;trans;m;n;k;lda;ldb;rh;qra;qrp;llvl;hlvl;domino;seedA;seedB"; - test_zgels_hqr.fptr = testing_zgels_hqr; - test_zgels_hqr.next = NULL; - - testing_register( &test_zgels_hqr ); -} diff --git a/new-testing/testing_zgemm.c b/new-testing/testing_zgemm.c deleted file mode 100644 index 5b41ffb326232e0c49359d3ae9a5f6b92d5c8dc7..0000000000000000000000000000000000000000 --- a/new-testing/testing_zgemm.c +++ /dev/null @@ -1,137 +0,0 @@ -/** - * - * @file testing_zgemm.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgemm testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-07 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zgemm( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am, An, Bm, Bn; - int hres = 0; - CHAM_desc_t *descA, *descB, *descC, *descCinit; - - /* Read arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t transA = run_arg_get_trans( args, "transA", ChamNoTrans ); - cham_trans_t transB = run_arg_get_trans( args, "transB", ChamNoTrans ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( transA == ChamNoTrans ) ? M : K ) ); - int LDB = run_arg_get_int( args, "LDB", ( ( transB == ChamNoTrans ) ? K : N ) ); - int LDC = run_arg_get_int( args, "LDC", M ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zgemm( M, N, K ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculate the dimensions according to the transposition */ - if ( transA == ChamNoTrans ) { - Am = M; - An = K; - } - else { - Am = K; - An = M; - } - if ( transB == ChamNoTrans ) { - Bm = K; - Bn = N; - } - else { - Bm = N; - Bn = K; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - - /* Fill the matrices with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - CHAMELEON_zplrnt_Tile( descC, seedC ); - - /* Calculate the product */ - START_TIMING( t ); - hres = CHAMELEON_zgemm_Tile( transA, transB, alpha, descA, descB, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Check the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - CHAMELEON_zplrnt_Tile( descCinit, seedC ); - - hres += check_zgemm( args, transA, transB, alpha, descA, descB, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zgemm; -const char *zgemm_params[] = { "nb", "transA", "transB", "m", "n", "k", "lda", "ldb", - "ldc", "alpha", "beta", "seedA", "seedB", "seedC", NULL }; -const char *zgemm_output[] = { NULL }; -const char *zgemm_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zgemm_init( void ) __attribute__( ( constructor ) ); -void -testing_zgemm_init( void ) -{ - test_zgemm.name = "zgemm"; - test_zgemm.helper = "zgemm"; - test_zgemm.params = zgemm_params; - test_zgemm.output = zgemm_output; - test_zgemm.outchk = zgemm_outchk; - test_zgemm.params_list = "nb;P;transA;transB;m;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC"; - test_zgemm.fptr = testing_zgemm; - test_zgemm.next = NULL; - - testing_register( &test_zgemm ); -} diff --git a/new-testing/testing_zhemm.c b/new-testing/testing_zhemm.c deleted file mode 100644 index 8a710cce3c3d7134986389dcf3261df905889d99..0000000000000000000000000000000000000000 --- a/new-testing/testing_zhemm.c +++ /dev/null @@ -1,129 +0,0 @@ -/** - * - * @file testing_zhemm.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zhemm testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-08 - * @precisions normal z -> c - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zhemm( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am; - int hres = 0; - CHAM_desc_t *descA, *descB, *descC, *descCinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( side == ChamLeft ) ? M : N ) ); - int LDB = run_arg_get_int( args, "LDB", M ); - int LDC = run_arg_get_int( args, "LDC", M ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - double bump = testing_dalea(); - bump = run_arg_get_double( args, "bump", bump ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zhemm( side, M, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculate the dimensions according to the side */ - if ( side == ChamLeft ) { - Am = M; - } - else { - Am = N; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, Am, 0, 0, Am, Am, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplghe_Tile( bump, uplo, descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - CHAMELEON_zplrnt_Tile( descC, seedC ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_zhemm_Tile( side, uplo, alpha, descA, descB, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - CHAMELEON_zplrnt_Tile( descCinit, seedC ); - - hres += - check_zsymm( args, ChamHermitian, side, uplo, alpha, descA, descB, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zhemm; -const char *zhemm_params[] = { "nb", "side", "uplo", "m", "n", "lda", "ldb", "ldc", - "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; -const char *zhemm_output[] = { NULL }; -const char *zhemm_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zhemm_init( void ) __attribute__( ( constructor ) ); -void -testing_zhemm_init( void ) -{ - test_zhemm.name = "zhemm"; - test_zhemm.helper = "zhemm"; - test_zhemm.params = zhemm_params; - test_zhemm.output = zhemm_output; - test_zhemm.outchk = zhemm_outchk; - test_zhemm.params_list = "nb;P;side;uplo;m;n;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; - test_zhemm.fptr = testing_zhemm; - test_zhemm.next = NULL; - - testing_register( &test_zhemm ); -} diff --git a/new-testing/testing_zher2k.c b/new-testing/testing_zher2k.c deleted file mode 100644 index 874c6f3b3d347b724b60aef9dd14ae0b086a7133..0000000000000000000000000000000000000000 --- a/new-testing/testing_zher2k.c +++ /dev/null @@ -1,131 +0,0 @@ -/** - * - * @file testing_zher2k.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zher2k testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-09 - * @precisions normal z -> z c - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zher2k( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am, An; - int hres = 0; - CHAM_desc_t *descA, *descB, *descC, *descCinit; - - /* Read arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDB = run_arg_get_int( args, "LDB", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDC = run_arg_get_int( args, "LDC", N ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - double beta = testing_dalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - double bump = testing_dalea(); - bump = run_arg_get_double( args, "bump", bump ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zher2k( K, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_double( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculate the dimensions according to the transposition */ - if ( trans == ChamNoTrans ) { - Am = N; - An = K; - } - else { - Am = K; - An = N; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - - /* Fill the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - CHAMELEON_zplghe_Tile( bump, uplo, descC, seedC ); - - /* Calculate the product */ - START_TIMING( t ); - hres = CHAMELEON_zher2k_Tile( uplo, trans, alpha, descA, descB, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Check the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - CHAMELEON_zplghe_Tile( bump, uplo, descCinit, seedC ); - - hres += - check_zsyrk( args, ChamHermitian, uplo, trans, alpha, descA, descB, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zher2k; -const char *zher2k_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldb", "ldc", - "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; -const char *zher2k_output[] = { NULL }; -const char *zher2k_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zher2k_init( void ) __attribute__( ( constructor ) ); -void -testing_zher2k_init( void ) -{ - test_zher2k.name = "zher2k"; - test_zher2k.helper = "zher2k"; - test_zher2k.params = zher2k_params; - test_zher2k.output = zher2k_output; - test_zher2k.outchk = zher2k_outchk; - test_zher2k.params_list = "nb;P;trans;uplo;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; - test_zher2k.fptr = testing_zher2k; - test_zher2k.next = NULL; - - testing_register( &test_zher2k ); -} diff --git a/new-testing/testing_zherk.c b/new-testing/testing_zherk.c deleted file mode 100644 index e4a6035fb9f64067782bed12a23ce21307b89a4a..0000000000000000000000000000000000000000 --- a/new-testing/testing_zherk.c +++ /dev/null @@ -1,126 +0,0 @@ -/** - * - * @file testing_zherk.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zherk testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-09 - * @precisions normal z -> z c - * - */ -#include <chameleon.h> -#include "flops.h" -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zherk( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am, An; - int hres = 0; - CHAM_desc_t *descA, *descC, *descCinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDC = run_arg_get_int( args, "LDC", N ); - double alpha = testing_dalea(); - double beta = testing_dalea(); - double bump = testing_dalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zherk( K, N ); - - alpha = run_arg_get_double( args, "alpha", alpha ); - beta = run_arg_get_double( args, "beta", beta ); - bump = run_arg_get_double( args, "bump", bump ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculates the dimensions according to the transposition */ - if ( trans == ChamNoTrans ) { - Am = N; - An = K; - } - else { - Am = K; - An = N; - } - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplghe_Tile( bump, uplo, descC, seedC ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_zherk_Tile( uplo, trans, alpha, descA, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - CHAMELEON_zplghe_Tile( bump, uplo, descCinit, seedC ); - - hres += - check_zsyrk( args, ChamHermitian, uplo, trans, alpha, descA, NULL, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zherk; -const char *zherk_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldc", - "alpha", "beta", "seedA", "seedC", "bump", NULL }; -const char *zherk_output[] = { NULL }; -const char *zherk_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zherk_init( void ) __attribute__( ( constructor ) ); -void -testing_zherk_init( void ) -{ - test_zherk.name = "zherk"; - test_zherk.helper = "zherk"; - test_zherk.params = zherk_params; - test_zherk.output = zherk_output; - test_zherk.outchk = zherk_outchk; - test_zherk.params_list = "nb;P;trans;uplo;n;k;lda;ldc;alpha;beta;seedA;seedC;bump"; - test_zherk.fptr = testing_zherk; - test_zherk.next = NULL; - - testing_register( &test_zherk ); -} diff --git a/new-testing/testing_zlange.c b/new-testing/testing_zlange.c deleted file mode 100644 index 69ab4fa0874d45172a02f9ceafe46e0e1fd94439..0000000000000000000000000000000000000000 --- a/new-testing/testing_zlange.c +++ /dev/null @@ -1,120 +0,0 @@ -/** - * - * @file testing_zlange.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zlange testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2014-07-13 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -static cham_fixdbl_t -flops_zlange( cham_normtype_t ntype, int M, int N ) -{ - cham_fixdbl_t flops = 0.; - double coefabs = 1.; -#if defined( PRECISION_z ) || defined( PRECISION_c ) - coefabs = 3.; -#endif - - switch ( ntype ) { - case ChamMaxNorm: - flops = coefabs * M * N; - break; - case ChamOneNorm: - flops = coefabs * M * N + M * ( N - 1 ); - break; - case ChamInfNorm: - flops = coefabs * M * N + N * ( M - 1 ); - break; - case ChamFrobeniusNorm: - flops = ( coefabs + 1. ) * M * N; - break; - default:; - } - return flops; -} - -int -testing_zlange( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres = 0; - double norm; - CHAM_desc_t *descA; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_normtype_t norm_type = run_arg_get_ntype( args, "norm", ChamMaxNorm ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int LDA = run_arg_get_int( args, "LDA", M ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zlange( norm_type, M, N ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Creates the matrix */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - - /* Calculates the norm */ - START_TIMING( t ); - norm = CHAMELEON_zlange_Tile( norm_type, descA ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( norm >= 0. ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - hres = check_znorm( args, ChamGeneral, norm_type, ChamUpperLower, ChamNonUnit, norm, descA ); - } - - CHAMELEON_Desc_Destroy( &descA ); - - run_id++; - return hres; -} - -testing_t test_zlange; -const char *zlange_params[] = { "nb", "norm", "m", "n", "lda", "seedA", NULL }; -const char *zlange_output[] = { NULL }; -const char *zlange_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zlange_init( void ) __attribute__( ( constructor ) ); -void -testing_zlange_init( void ) -{ - test_zlange.name = "zlange"; - test_zlange.helper = "zlange"; - test_zlange.params = zlange_params; - test_zlange.output = zlange_output; - test_zlange.outchk = zlange_outchk; - test_zlange.params_list = "nb;P;norm;m;n;lda;seedA"; - test_zlange.fptr = testing_zlange; - test_zlange.next = NULL; - - testing_register( &test_zlange ); -} diff --git a/new-testing/testing_zposv.c b/new-testing/testing_zposv.c deleted file mode 100644 index b349917264c7576abc460eb6fdf5d8e8de1364ab..0000000000000000000000000000000000000000 --- a/new-testing/testing_zposv.c +++ /dev/null @@ -1,121 +0,0 @@ -/** - * - * @file testing_zposv.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zposv testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-12 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -static cham_fixdbl_t -flops_zposv( int N, int NRHS ) -{ - cham_fixdbl_t flops = flops_zpotrf( N ) + flops_zpotrs( N, NRHS ); - return flops; -} - -int -testing_zposv( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres = 0; - CHAM_desc_t *descA, *descX; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int NRHS = run_arg_get_int( args, "NRHS", 1 ); - int LDA = run_arg_get_int( args, "LDA", N ); - int LDB = run_arg_get_int( args, "LDB", N ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zposv( N, NRHS ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); - CHAMELEON_Desc_Create( - &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, N, NRHS, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, seedA ); - CHAMELEON_zplrnt_Tile( descX, seedB ); - - /* Calculates the solution */ - START_TIMING( t ); - hres = CHAMELEON_zposv_Tile( uplo, descA, descX ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the factorisation and residue */ - if ( check ) { - CHAM_desc_t *descA0, *descB; - - /* Check the factorization */ - descA0 = CHAMELEON_Desc_Copy( descA, NULL ); - CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); - - hres += check_zxxtrf( args, ChamHermitian, uplo, descA0, descA ); - - /* Check the solve */ - descB = CHAMELEON_Desc_Copy( descX, NULL ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); - hres += check_zsolve( args, ChamHermitian, ChamNoTrans, uplo, descA0, descX, descB ); - - CHAMELEON_Desc_Destroy( &descA0 ); - CHAMELEON_Desc_Destroy( &descB ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descX ); - - run_id++; - return hres; -} - -testing_t test_zposv; -const char *zposv_params[] = { "nb", "uplo", "n", "nrhs", "lda", "ldb", "seedA", "seedB", NULL }; -const char *zposv_output[] = { NULL }; -const char *zposv_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zposv_init( void ) __attribute__( ( constructor ) ); -void -testing_zposv_init( void ) -{ - test_zposv.name = "zposv"; - test_zposv.helper = "zposv"; - test_zposv.params = zposv_params; - test_zposv.output = zposv_output; - test_zposv.outchk = zposv_outchk; - test_zposv.params_list = "nb;P;uplo;n;nrhs;lda;ldb;seedA;seedB"; - test_zposv.fptr = testing_zposv; - test_zposv.next = NULL; - - testing_register( &test_zposv ); -} diff --git a/new-testing/testing_zpotri.c b/new-testing/testing_zpotri.c deleted file mode 100644 index c56b67eeaf08aaae56618477569bc9204320781e..0000000000000000000000000000000000000000 --- a/new-testing/testing_zpotri.c +++ /dev/null @@ -1,101 +0,0 @@ -/** - * - * @file testing_zpotri.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zpotri testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-13 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include <assert.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zpotri( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int hres; - CHAM_desc_t *descA; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int LDA = run_arg_get_int( args, "LDA", N ); - int seedA = run_arg_get_int( args, "seedA", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zpotri( N ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); - - /* Initialise the matrix with the random values */ - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, seedA ); - - hres = CHAMELEON_zpotrf_Tile( uplo, descA ); - assert( hres == 0 ); - - /* Calculates the inversed matrix */ - START_TIMING( t ); - hres += CHAMELEON_zpotri_Tile( uplo, descA ); - STOP_TIMING( t ); - - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Check the inverse */ - if ( check ) { - CHAM_desc_t *descA0 = CHAMELEON_Desc_Copy( descA, NULL ); - CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); - - hres += check_ztrtri( args, ChamHermitian, uplo, ChamNonUnit, descA0, descA ); - - CHAMELEON_Desc_Destroy( &descA0 ); - } - - CHAMELEON_Desc_Destroy( &descA ); - - run_id++; - return hres; -} - -testing_t test_zpotri; -const char *zpotri_params[] = { "nb", "uplo", "n", "lda", "seedA", NULL }; -const char *zpotri_output[] = { NULL }; -const char *zpotri_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zpotri_init( void ) __attribute__( ( constructor ) ); -void -testing_zpotri_init( void ) -{ - test_zpotri.name = "zpotri"; - test_zpotri.helper = "zpotri"; - test_zpotri.params = zpotri_params; - test_zpotri.output = zpotri_output; - test_zpotri.outchk = zpotri_outchk; - test_zpotri.params_list = "nb;P;uplo;n;lda;seedA"; - test_zpotri.fptr = testing_zpotri; - test_zpotri.next = NULL; - - testing_register( &test_zpotri ); -} diff --git a/new-testing/testing_zsymm.c b/new-testing/testing_zsymm.c deleted file mode 100644 index c15b2bbe6acbb2632d3bed325ee0c7e52f854051..0000000000000000000000000000000000000000 --- a/new-testing/testing_zsymm.c +++ /dev/null @@ -1,129 +0,0 @@ -/** - * - * @file testing_zsymm.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zsymm testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-08 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zsymm( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am; - int hres = 0; - CHAM_desc_t *descA, *descB, *descC, *descCinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int M = run_arg_get_int( args, "M", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( side == ChamLeft ) ? M : N ) ); - int LDB = run_arg_get_int( args, "LDB", M ); - int LDC = run_arg_get_int( args, "LDC", M ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - double bump = testing_dalea(); - bump = run_arg_get_double( args, "bump", bump ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zsymm( side, M, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculate the dimensions according to the side */ - if ( side == ChamLeft ) { - Am = M; - } - else { - Am = N; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, Am, 0, 0, Am, Am, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplgsy_Tile( bump, uplo, descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - CHAMELEON_zplrnt_Tile( descC, seedC ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_zsymm_Tile( side, uplo, alpha, descA, descB, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); - CHAMELEON_zplrnt_Tile( descCinit, seedC ); - - hres += - check_zsymm( args, ChamSymmetric, side, uplo, alpha, descA, descB, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zsymm; -const char *zsymm_params[] = { "nb", "side", "uplo", "m", "n", "lda", "ldb", "ldc", - "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; -const char *zsymm_output[] = { NULL }; -const char *zsymm_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zsymm_init( void ) __attribute__( ( constructor ) ); -void -testing_zsymm_init( void ) -{ - test_zsymm.name = "zsymm"; - test_zsymm.helper = "zsymm"; - test_zsymm.params = zsymm_params; - test_zsymm.output = zsymm_output; - test_zsymm.outchk = zsymm_outchk; - test_zsymm.params_list = "nb;P;side;uplo;m;n;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; - test_zsymm.fptr = testing_zsymm; - test_zsymm.next = NULL; - - testing_register( &test_zsymm ); -} diff --git a/new-testing/testing_zsyr2k.c b/new-testing/testing_zsyr2k.c deleted file mode 100644 index cf3ace77d658b5dea16dbe0118534fd952abc186..0000000000000000000000000000000000000000 --- a/new-testing/testing_zsyr2k.c +++ /dev/null @@ -1,131 +0,0 @@ -/** - * - * @file testing_zsyr2k.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zsyr2k testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-09 - * @precisions normal z -> z c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zsyr2k( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am, An; - int hres = 0; - CHAM_desc_t *descA, *descB, *descC, *descCinit; - - /* Read arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDB = run_arg_get_int( args, "LDB", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDC = run_arg_get_int( args, "LDC", N ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - double bump = testing_dalea(); - bump = run_arg_get_double( args, "bump", bump ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zher2k( K, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculate the dimensions according to the transposition */ - if ( trans == ChamNoTrans ) { - Am = N; - An = K; - } - else { - Am = K; - An = N; - } - - /* Create the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - - /* Fill the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - CHAMELEON_zplgsy_Tile( bump, uplo, descC, seedC ); - - /* Calculate the product */ - START_TIMING( t ); - hres = CHAMELEON_zsyr2k_Tile( uplo, trans, alpha, descA, descB, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Check the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - CHAMELEON_zplgsy_Tile( bump, uplo, descCinit, seedC ); - - hres += - check_zsyrk( args, ChamSymmetric, uplo, trans, alpha, descA, descB, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zsyr2k; -const char *zsyr2k_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldb", "ldc", - "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; -const char *zsyr2k_output[] = { NULL }; -const char *zsyr2k_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zsyr2k_init( void ) __attribute__( ( constructor ) ); -void -testing_zsyr2k_init( void ) -{ - test_zsyr2k.name = "zsyr2k"; - test_zsyr2k.helper = "zsyr2k"; - test_zsyr2k.params = zsyr2k_params; - test_zsyr2k.output = zsyr2k_output; - test_zsyr2k.outchk = zsyr2k_outchk; - test_zsyr2k.params_list = "nb;P;trans;uplo;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; - test_zsyr2k.fptr = testing_zsyr2k; - test_zsyr2k.next = NULL; - - testing_register( &test_zsyr2k ); -} diff --git a/new-testing/testing_zsyrk.c b/new-testing/testing_zsyrk.c deleted file mode 100644 index 34a181391f12ee214b4e00e1d7a67a94fd7d45b1..0000000000000000000000000000000000000000 --- a/new-testing/testing_zsyrk.c +++ /dev/null @@ -1,125 +0,0 @@ -/** - * - * @file testing_zsyrk.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zsyrk testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-09 - * @precisions normal z -> z c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_zsyrk( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Am, An; - int hres = 0; - CHAM_desc_t *descA, *descC, *descCinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); - int LDC = run_arg_get_int( args, "LDC", N ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - CHAMELEON_Complex64_t beta = testing_zalea(); - CHAMELEON_Complex64_t bump = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedC = run_arg_get_int( args, "seedC", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_zsyrk( K, N ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - beta = run_arg_get_complex64( args, "beta", beta ); - bump = run_arg_get_complex64( args, "bump", bump ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculates the dimensions according to the transposition */ - if ( trans == ChamNoTrans ) { - Am = N; - An = K; - } - else { - Am = K; - An = N; - } - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); - CHAMELEON_Desc_Create( - &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplgsy_Tile( bump, uplo, descC, seedC ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_zsyrk_Tile( uplo, trans, alpha, descA, beta, descC ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); - CHAMELEON_zplgsy_Tile( bump, uplo, descCinit, seedC ); - - hres += - check_zsyrk( args, ChamSymmetric, uplo, trans, alpha, descA, NULL, beta, descCinit, descC ); - - CHAMELEON_Desc_Destroy( &descCinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descC ); - - run_id++; - return hres; -} - -testing_t test_zsyrk; -const char *zsyrk_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldc", - "alpha", "beta", "seedA", "seedC", "bump", NULL }; -const char *zsyrk_output[] = { NULL }; -const char *zsyrk_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_zsyrk_init( void ) __attribute__( ( constructor ) ); -void -testing_zsyrk_init( void ) -{ - test_zsyrk.name = "zsyrk"; - test_zsyrk.helper = "zsyrk"; - test_zsyrk.params = zsyrk_params; - test_zsyrk.output = zsyrk_output; - test_zsyrk.outchk = zsyrk_outchk; - test_zsyrk.params_list = "nb;P;trans;uplo;n;k;lda;ldc;alpha;beta;seedA;seedC;bump"; - test_zsyrk.fptr = testing_zsyrk; - test_zsyrk.next = NULL; - - testing_register( &test_zsyrk ); -} diff --git a/new-testing/testing_ztrmm.c b/new-testing/testing_ztrmm.c deleted file mode 100644 index 1ef480dd675f8e21680e8a1f82ab80be63f83d96..0000000000000000000000000000000000000000 --- a/new-testing/testing_ztrmm.c +++ /dev/null @@ -1,122 +0,0 @@ -/** - * - * @file testing_ztrmm.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon ztrmm testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-12 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_ztrmm( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Bm, Bn; - int hres = 0; - CHAM_desc_t *descA, *descB, *descBinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - cham_diag_t diag = run_arg_get_diag( args, "diag", ChamNonUnit ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", N ); - int LDB = run_arg_get_int( args, "LDB", N ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_ztrmm( side, N, K ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculates the dimensions according to the side */ - if ( side == ChamLeft ) { - Bm = N; - Bn = K; - } - else { - Bm = K; - Bn = N; - } - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); - - /* Fills the matrix with random values */ - CHAMELEON_zplrnt_Tile( descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_ztrmm_Tile( side, uplo, trans, diag, alpha, descA, descB ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descBinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); - CHAMELEON_zplrnt_Tile( descBinit, seedB ); - - hres += check_ztrmm( args, CHECK_TRMM, side, uplo, trans, diag, alpha, descA, descB, descBinit ); - - CHAMELEON_Desc_Destroy( &descBinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - - run_id++; - return hres; -} - -testing_t test_ztrmm; -const char *ztrmm_params[] = { "nb", "trans", "side", "uplo", "diag", "n", "k", - "lda", "ldb", "alpha", "seedA", "seedB", NULL }; -const char *ztrmm_output[] = { NULL }; -const char *ztrmm_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_ztrmm_init( void ) __attribute__( ( constructor ) ); -void -testing_ztrmm_init( void ) -{ - test_ztrmm.name = "ztrmm"; - test_ztrmm.helper = "ztrmm"; - test_ztrmm.params = ztrmm_params; - test_ztrmm.output = ztrmm_output; - test_ztrmm.outchk = ztrmm_outchk; - test_ztrmm.params_list = "nb;P;trans;side;uplo;diag;n;k;lda;ldb;alpha;seedA;seedB"; - test_ztrmm.fptr = testing_ztrmm; - test_ztrmm.next = NULL; - - testing_register( &test_ztrmm ); -} diff --git a/new-testing/testing_ztrsm.c b/new-testing/testing_ztrsm.c deleted file mode 100644 index 3922d156f846bd4ae7934a60f750b04fa7ac5e59..0000000000000000000000000000000000000000 --- a/new-testing/testing_ztrsm.c +++ /dev/null @@ -1,123 +0,0 @@ -/** - * - * @file testing_ztrsm.c - * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon ztrsm testing - * - * @version 0.9.2 - * @author Lucas Barros de Assis - * @date 2019-08-12 - * @precisions normal z -> c d s - * - */ -#include <chameleon.h> -#include "testing_zauxiliary.h" -#include "testing_zcheck.h" -#include "flops.h" - -int -testing_ztrsm( run_arg_list_t *args, int check ) -{ - static int run_id = 0; - int Bm, Bn; - int hres = 0; - CHAM_desc_t *descA, *descB, *descBinit; - - /* Reads arguments */ - int nb = run_arg_get_int( args, "nb", 320 ); - int P = parameters_getvalue_int( "P" ); - cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); - cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); - cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); - cham_diag_t diag = run_arg_get_diag( args, "diag", ChamNonUnit ); - int N = run_arg_get_int( args, "N", 1000 ); - int K = run_arg_get_int( args, "K", N ); - int LDA = run_arg_get_int( args, "LDA", N ); - int LDB = run_arg_get_int( args, "LDB", N ); - CHAMELEON_Complex64_t alpha = testing_zalea(); - int seedA = run_arg_get_int( args, "seedA", random() ); - int seedB = run_arg_get_int( args, "seedB", random() ); - int Q = parameters_compute_q( P ); - cham_fixdbl_t t, gflops; - cham_fixdbl_t flops = flops_ztrsm( side, N, K ); - - alpha = run_arg_get_complex64( args, "alpha", alpha ); - - CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); - - /* Calculates the dimensions according to the side */ - if ( side == ChamLeft ) { - Bm = N; - Bn = K; - } - else { - Bm = K; - Bn = N; - } - - /* Creates the matrices */ - CHAMELEON_Desc_Create( - &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); - CHAMELEON_Desc_Create( - &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); - - /* Fills the matrix with random values */ - /* We bump a little bit the diagonal to make it stable */ - CHAMELEON_zplgsy_Tile( 2., uplo, descA, seedA ); - CHAMELEON_zplrnt_Tile( descB, seedB ); - - /* Calculates the product */ - START_TIMING( t ); - hres = CHAMELEON_ztrsm_Tile( side, uplo, trans, diag, alpha, descA, descB ); - STOP_TIMING( t ); - gflops = flops * 1.e-9 / t; - run_arg_add_fixdbl( args, "time", t ); - run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - - /* Checks the solution */ - if ( check ) { - CHAMELEON_Desc_Create( - &descBinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); - CHAMELEON_zplrnt_Tile( descBinit, seedB ); - - hres += check_ztrmm( args, CHECK_TRSM, side, uplo, trans, diag, alpha, descA, descB, descBinit ); - - CHAMELEON_Desc_Destroy( &descBinit ); - } - - CHAMELEON_Desc_Destroy( &descA ); - CHAMELEON_Desc_Destroy( &descB ); - - run_id++; - return hres; -} - -testing_t test_ztrsm; -const char *ztrsm_params[] = { "nb", "trans", "side", "uplo", "diag", "n", "k", - "lda", "ldb", "alpha", "seedA", "seedB", NULL }; -const char *ztrsm_output[] = { NULL }; -const char *ztrsm_outchk[] = { "RETURN", NULL }; - -/** - * @brief Testing registration function - */ -void testing_ztrsm_init( void ) __attribute__( ( constructor ) ); -void -testing_ztrsm_init( void ) -{ - test_ztrsm.name = "ztrsm"; - test_ztrsm.helper = "ztrsm"; - test_ztrsm.params = ztrsm_params; - test_ztrsm.output = ztrsm_output; - test_ztrsm.outchk = ztrsm_outchk; - test_ztrsm.params_list = "nb;P;trans;side;uplo;diag;n;k;lda;ldb;alpha;seedA;seedB"; - test_ztrsm.fptr = testing_ztrsm; - test_ztrsm.next = NULL; - - testing_register( &test_ztrsm ); -} diff --git a/plasma-conversion/callGeneration.bash b/plasma-conversion/callGeneration.bash deleted file mode 100755 index 9bfb98e36676c554e939dfaa10fdc22d83466c64..0000000000000000000000000000000000000000 --- a/plasma-conversion/callGeneration.bash +++ /dev/null @@ -1,454 +0,0 @@ -#!/bin/bash -### -# -# @file callGeneration.bash -# -# @copyright 2009-2015 The University of Tennessee and The University of -# Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, -# Univ. Bordeaux. All rights reserved. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @author Florent Pruvost -# @date 2016-08-17 -# -### - -# plasma release to download -plasma_relname=2.8.0 -plasma_rel=plasma_$plasma_relname.tar.gz -plasma_url=http://icl.cs.utk.edu/projectsfiles/plasma/pubs/$plasma_rel -if [[ ! -e $plasma_rel ]]; then - echo "$plasma_rel does not exists, y to download it" - wget $plasma_url -fi -if [[ ! -e plasma_$plasma_relname ]]; then - tar zxf $plasma_rel -fi - -# Define the paths -# ---------------- - -# where the script is called -plasma_conv_dir="$PWD" -# source files of the conversion (plasma -> chameleon) -plasma_dir="$PWD/plasma_$plasma_relname" -# source of the licence -licence_dir="$PWD/insert-licence" -# source of the original chameleon -# ex in this plasma_conversion directory: svn checkout https://scm.gforge.inria.fr/anonscm/svn/morse/trunk/chameleon -chameleon_dir="$PWD/.." -# source of the converted chameleon -chameleon_tmp="$PWD/chameleon" - -if [[ ! -e $plasma_dir ]]; then - echo "plasma_dir is set to $plasma_dir which does not exist, please set the variable plasma_dir in the script $0" - exit $? -fi -if [[ ! -e $licence_dir ]]; then - echo "licence_dir is set to $licence_dir which does not exist, please set the variable licence_dir in the script $0" - exit $? -fi -if [[ ! -e $chameleon_dir ]]; then - echo "chameleon_dir is set to $chameleon_dir which does not exist, try to download it" - svn export svn+ssh://fpruvost@scm.gforge.inria.fr/svnroot/morse/trunk/chameleon - if [[ ! -e $chameleon_dir ]]; then - echo "chameleon_dir is set to $chameleon_dir which does not exist, please set the variable chameleon_dir in the script $0 and check that this path exists" - exit $? - fi -fi -if [[ ! -e $chameleon_tmp ]]; then - echo "chameleon_tmp is set to $chameleon_tmp which does not exist, lets create it" - mkdir $chameleon_tmp - if [[ ! -e $chameleon_tmp ]]; then - echo "chameleon_tmp is set to $chameleon_tmp which does not exist, please set the variable chameleon_tmp in the script $0" - exit $? - fi -fi - -# Definition of files list -# ------------------------ -list_file=" -include/core_zblas.h -include/core_zcblas.h -include/plasma_z.h -include/plasma_zc.h -control/compute_z.h -control/workspace_z.c -control/plasma_zcf90.F90 -control/plasma_zf77.c -control/plasma_zf90.F90 -control/plasma_zf90_wrappers.F90 - -core_blas/core_dzasum.c -core_blas/core_zgemm.c -core_blas/core_zgessq.c -core_blas/core_zhemm.c -core_blas/core_zhessq.c -core_blas/core_zher2k.c -core_blas/core_zherk.c -core_blas/core_zpemv.c -core_blas/core_zsymm.c -core_blas/core_zsyr2k.c -core_blas/core_zsyrk.c -core_blas/core_zsyssq.c -core_blas/core_ztrasm.c -core_blas/core_ztrmm.c -core_blas/core_ztrsm.c -core_blas/core_ztrssq.c -core_blas/core_zgeadd.c -core_blas/core_zgelqt.c -core_blas/core_zgeqrt.c -core_blas/core_zgessm.c -core_blas/core_zgetrf.c -core_blas/core_zgetrf_incpiv.c -core_blas/core_zgetf2_nopiv.c -core_blas/core_zgetrf_nopiv.c -core_blas/core_zlacpy.c -core_blas/core_zlag2c.c -core_blas/core_zlange.c -core_blas/core_zlanhe.c -core_blas/core_zlansy.c -core_blas/core_zlantr.c -core_blas/core_zlaset2.c -core_blas/core_zlaset.c -core_blas/core_zlauum.c -core_blas/core_zpamm.c -core_blas/core_zparfb.c -core_blas/core_zplghe.c -core_blas/core_zplgsy.c -core_blas/core_zplrnt.c -core_blas/core_zpltmg.c -core_blas/core_zpotrf.c -core_blas/core_zssssm.c -core_blas/core_ztrtri.c -core_blas/core_ztslqt.c -core_blas/core_ztsmlq.c -core_blas/core_ztsmqr.c -core_blas/core_ztsqrt.c -core_blas/core_ztstrf.c -core_blas/core_zttlqt.c -core_blas/core_zttmlq.c -core_blas/core_zttmqr.c -core_blas/core_zttqrt.c -core_blas/core_zunmlq.c -core_blas/core_zunmqr.c - -core_blas-qwrapper/qwrapper_dzasum.c -core_blas-qwrapper/qwrapper_zgemm.c -core_blas-qwrapper/qwrapper_zgessq.c -core_blas-qwrapper/qwrapper_zhemm.c -core_blas-qwrapper/qwrapper_zher2k.c -core_blas-qwrapper/qwrapper_zherk.c -core_blas-qwrapper/qwrapper_zpemv.c -core_blas-qwrapper/qwrapper_zplssq.c -core_blas-qwrapper/qwrapper_zhessq.c -core_blas-qwrapper/qwrapper_zsymm.c -core_blas-qwrapper/qwrapper_zsyr2k.c -core_blas-qwrapper/qwrapper_zsyrk.c -core_blas-qwrapper/qwrapper_zsyssq.c -core_blas-qwrapper/qwrapper_ztrasm.c -core_blas-qwrapper/qwrapper_ztrmm.c -core_blas-qwrapper/qwrapper_ztrsm.c -core_blas-qwrapper/qwrapper_ztrssq.c -core_blas-qwrapper/qwrapper_zgeadd.c -core_blas-qwrapper/qwrapper_zgelqt.c -core_blas-qwrapper/qwrapper_zgeqrt.c -core_blas-qwrapper/qwrapper_zgessm.c -core_blas-qwrapper/qwrapper_zgetrf.c -core_blas-qwrapper/qwrapper_zgetrf_incpiv.c -core_blas-qwrapper/qwrapper_zgetf2_nopiv.c -core_blas-qwrapper/qwrapper_zgetrf_nopiv.c -core_blas-qwrapper/qwrapper_zlacpy.c -core_blas-qwrapper/qwrapper_zlag2c.c -core_blas-qwrapper/qwrapper_zlange.c -core_blas-qwrapper/qwrapper_zlanhe.c -core_blas-qwrapper/qwrapper_zlansy.c -core_blas-qwrapper/qwrapper_zlantr.c -core_blas-qwrapper/qwrapper_zlaset2.c -core_blas-qwrapper/qwrapper_zlaset.c -core_blas-qwrapper/qwrapper_zlauum.c -core_blas-qwrapper/qwrapper_zpamm.c -core_blas-qwrapper/qwrapper_zparfb.c -core_blas-qwrapper/qwrapper_zplghe.c -core_blas-qwrapper/qwrapper_zplgsy.c -core_blas-qwrapper/qwrapper_zplrnt.c -core_blas-qwrapper/qwrapper_zpltmg.c -core_blas-qwrapper/qwrapper_zpotrf.c -core_blas-qwrapper/qwrapper_zssssm.c -core_blas-qwrapper/qwrapper_ztrtri.c -core_blas-qwrapper/qwrapper_ztslqt.c -core_blas-qwrapper/qwrapper_ztsmlq.c -core_blas-qwrapper/qwrapper_ztsmqr.c -core_blas-qwrapper/qwrapper_ztsqrt.c -core_blas-qwrapper/qwrapper_ztstrf.c -core_blas-qwrapper/qwrapper_zttlqt.c -core_blas-qwrapper/qwrapper_zttmlq.c -core_blas-qwrapper/qwrapper_zttmqr.c -core_blas-qwrapper/qwrapper_zttqrt.c -core_blas-qwrapper/qwrapper_zunmlq.c - -compute/pzgemm.c -compute/pzhemm.c -compute/pzher2k.c -compute/pzherk.c -compute/pzsymm.c -compute/pzsyr2k.c -compute/pzsyrk.c -compute/pztrmm.c -compute/pztrsm.c -compute/pztrsmpl.c -compute/pzgeadd.c -compute/pzgelqf.c -compute/pzgelqfrh.c -compute/pzgeqrf.c -compute/pzgeqrfrh.c -compute/pzgetrf_incpiv.c -compute/pzgetrf_nopiv.c -compute/pzlacpy.c -compute/pzlag2c.c -compute/pzlange.c -compute/pzlanhe.c -compute/pzlansy.c -compute/pzlantr.c -compute/pzlaset2.c -compute/pzlaset.c -compute/pzlauum.c -compute/pzplghe.c -compute/pzplgsy.c -compute/pzpltmg.c -compute/pzpotrf.c -compute/pztrtri.c -compute/pzunglq.c -compute/pzunglqrh.c -compute/pzungqr.c -compute/pzungqrrh.c -compute/pzunmlq.c -compute/pzunmlqrh.c -compute/pzunmqr.c -compute/pzunmqrrh.c - -compute/zgels.c -compute/zgelqs.c -compute/zgelqf.c -compute/zgemm.c -compute/zgeqrf.c -compute/zgeqrs.c -compute/zgetrf_incpiv.c -compute/zgetrf_nopiv.c -compute/zgetrs_incpiv.c -compute/zgesv_incpiv.c -compute/zhemm.c -compute/zher2k.c -compute/zherk.c -compute/zsymm.c -compute/zsyr2k.c -compute/zsyrk.c -compute/ztrmm.c -compute/ztrsm.c -compute/ztrsmpl.c -compute/zlacpy.c -compute/zlange.c -compute/zlanhe.c -compute/zlansy.c -compute/zlantr.c -compute/zlaset.c -compute/zlauum.c -compute/zplghe.c -compute/zplgsy.c -compute/zplrnt.c -compute/zpltmg.c -compute/zposv.c -compute/zpotrf.c -compute/zpotri.c -compute/zpotrs.c -compute/ztrtri.c -compute/zunglq.c -compute/zungqr.c -compute/zunmlq.c -compute/zunmqr.c - -testing/testing_zgemm.c -testing/testing_zhemm.c -testing/testing_zher2k.c -testing/testing_zherk.c -testing/testing_zlange.c -testing/testing_zsymm.c -testing/testing_zsyr2k.c -testing/testing_zsyrk.c -testing/testing_ztrmm.c -testing/testing_ztrsm.c -testing/testing_zpemv.c -testing/testing_zposv.c -testing/testing_zpotri.c -testing/testing_zgels.c -testing/testing_zgesv_incpiv.c - -timing/time_zgemm.c -timing/time_zgemm_tile.c -timing/time_ztrsm.c -timing/time_zgels.c -timing/time_zgels_tile.c -timing/time_zgeqrf.c -timing/time_zgeqrf_tile.c -timing/time_zgetrf_incpiv.c -timing/time_zgetrf_incpiv_tile.c -timing/time_zgetrf_nopiv.c -timing/time_zgetri_tile.c -timing/time_zposv.c -timing/time_zposv_tile.c -timing/time_zpotrf.c -timing/time_zpotrf_tile.c -timing/time_zpotri_tile.c -timing/time_zgesv_incpiv.c -timing/time_zgesv_incpiv_tile.c -" -# COREBLAS not used -# ----------------- -#core_blas/core_zbrdalg.c -#core_blas/core_zgbelr.c -#core_blas/core_zgblrx.c -#core_blas/core_zgbrce.c -#core_blas/core_zgessq.c -#core_blas/core_zgetrip.c -#core_blas/core_zgetrf_reclap.c -#core_blas/core_zgetrf_rectil.c -#core_blas/core_zhbelr.c -#core_blas/core_zhblrx.c -#core_blas/core_zhbrce.c -#core_blas/core_zhbtype1cb.c -#core_blas/core_zhbtype2cb.c -#core_blas/core_zhbtype3cb.c -#core_blas/core_zhegst.c -#core_blas/core_zherfb.c -#core_blas/core_zlarfb_gemm.c -#core_blas/core_zlarfx_tbrd.c -#core_blas/core_zlarfy.c -#core_blas/core_zlaswp.c -#core_blas/core_zlatro.c -#core_blas/core_zshift.c -#core_blas/core_zswpab.c -#core_blas/core_ztrdalg.c -#core_blas/core_ztsmlq_corner.c -#core_blas/core_ztsmlq_hetra1.c -#core_blas/core_ztsmqr_corner.c -#core_blas/core_ztsmqr_hetra1.c -#core_blas/core_ztsrfb.c - -# PCOMPUTE not used -# ----------------- -#compute/pzgebrd_ge2tb.c -#compute/pzgebrd_tb2bd.c -#compute/pzgetmi2.c -#compute/pzgetrf_reclap.c -#compute/pzgetrf_rectil.c -#compute/pzhbcpy_t2bl.c -#compute/pzhegst.c -#compute/pzherbt.c -#compute/pzhetrd_hb2st.c -#compute/pzhetrd_he2hb.c -#compute/pzlarft_blgtrd.c -#compute/pzlaswp.c -#compute/pzlaswpc.c -#compute/pztrsmrv.c -#compute/pzunmqr_blgtrd.c -# -#compute/pzbarrier.c -#compute/pzpack.c -#compute/pzshift.c - -# COMPUTE not used -# ---------------- -#compute/zgetrf.c -#compute/zgetri.c -#compute/zcgels.c -#compute/zcgesv.c -#compute/zcposv.c -#compute/zcungesv.c -#compute/zgebrd.c -#compute/zgecfi2.c -#compute/zgecfi2.h -#compute/zgecfi.c -#compute/zgesv.c -#compute/zgesvd.c -#compute/zgetmi.c -#compute/zgetrs.c -#compute/zheev.c -#compute/zheevd.c -#compute/zhegst.c -#compute/zhegv.c -#compute/zhegvd.c -#compute/zhetrd.c -#compute/zlaswp.c -#compute/zlaswpc.c -#compute/ztrsmrv.c - -# TIMING not used -# --------------- -#timing/time_zgetrf.c -#timing/time_zgetrf_tile.c -#timing/time_zcgesv.c -#timing/time_zcgesv_tile.c -#timing/time_zcposv.c -#timing/time_zcposv_tile.c -#timing/time_zgebrd_tile.c -#timing/time_zgetrf_reclap.c -#timing/time_zgetrf_rectil.c -#timing/time_zgecfi.c -#timing/time_zgesvd_tile.c -#timing/time_zheevd_tile.c -#timing/time_zheev_tile.c -#timing/time_zhegv_tile.c -#timing/time_zlapack2tile.c -#timing/time_zgesv.c -#timing/time_zgesv_tile.c - -# TESTING not used -# ---------------- -#testing/testing_zcgels.c -#testing/testing_zcgesv.c -#testing/testing_zcposv.c -#testing/testing_zcungesv.c -#testing/testing_zgecfi.c -#testing/testing_zgesv.c -#testing/testing_zgesvd.c -#testing/testing_zgetmi.c -#testing/testing_zgetri.c -#testing/testing_zheev.c -#testing/testing_zheevd.c -#testing/testing_zhegst.c -#testing/testing_zhegv.c -#testing/testing_zhegvd.c -#testing/testing_zlange.c - -# TIMING not used -# ---------------- -#timing/zauxiliary.h -#timing/zauxiliary.c - -# Génération des sources -# ---------------------- -python ${plasma_conv_dir}/generate_morseSrc.py -o ${chameleon_tmp} -p ${plasma_dir} -f "${list_file}" --force - -# Copie de la licence en entête des fichiers générés -current_dir=$PWD -cd ${chameleon_tmp} -${licence_dir}/insert-licence-chameleon.sh -cd ${current_dir} - -# Recopie de magma_morse -# ---------------------- -python ${plasma_conv_dir}/generate_morseSrc.py -o ${chameleon_dir} -m ${chameleon_tmp} --force diff --git a/plasma-conversion/fileConversion.py b/plasma-conversion/fileConversion.py deleted file mode 100644 index e283591500e919882285863f77571073ef87a7d2..0000000000000000000000000000000000000000 --- a/plasma-conversion/fileConversion.py +++ /dev/null @@ -1,350 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- -### -# -# -- Inria -# -- (C) Copyright 2012 -# -# This software is a computer program whose purpose is to process -# Matrices Over Runtime Systems @ Exascale (MORSE). More information -# can be found on the following website: http://www.inria.fr/en/teams/morse. -# -# This software is governed by the CeCILL-C license under French law and -# abiding by the rules of distribution of free software. You can use, -# modify and/ or redistribute the software under the terms of the CeCILL-C -# license as circulated by CEA, CNRS and INRIA at the following URL -# "http://www.cecill.info". -# -# As a counterpart to the access to the source code and rights to copy, -# modify and redistribute granted by the license, users are provided only -# with a limited warranty and the software's author, the holder of the -# economic rights, and the successive licensors have only limited -# liability. -# -# In this respect, the user's attention is drawn to the risks associated -# with loading, using, modifying and/or developing or reproducing the -# software by the user in light of its specific status of free software, -# that may mean that it is complicated to manipulate, and that also -# therefore means that it is reserved for developers and experienced -# professionals having in-depth computer knowledge. Users are therefore -# encouraged to load and test the software's suitability as regards their -# requirements in conditions enabling the security of their systems and/or -# data to be ensured and, more generally, to use and operate it in the -# same conditions as regards security. -# -# The fact that you are presently reading this means that you have had -# knowledge of the CeCILL-C license and that you accept its terms. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2016-08-17 -# -### - -import sys; -import os; -import string; - -import re; -import shutil; -from rulesSubstitutions import subs; - -def read_file(file): - fd = open(file, 'r') - filedata = fd.read() - fd.close() - return filedata - - -def write_file(file, filedata): - fd = open(file, 'w') - fd.write(filedata) - fd.close() - - -def update_file(file, filedata): - # read previous data - fd = open(file, 'r') - data = fd.read() - fd.close() - - # write new + previous data - fd = open(file, 'w') - fd.write(filedata + data) - fd.close() - - -def create_path(path): - path = os.path.abspath(path) - if os.path.exists(path) is False: - print 'create:',path - os.makedirs(path) - -def substitute_file(srcfilepath, dstfilepath, filetype): - print 'substitute : apply >>>',filetype,'<<< dictionnary' - print ' for',dstfilepath - - # Initialize filedata - filedata = read_file(srcfilepath) - - # Subsitute in data - work = subs[filetype] - for pattern in work: - condition = pattern[0] - search = pattern[1] - replace = pattern[2] - if not search: - continue - if condition == 'u': - filedata = re.sub(re.compile(search, re.M), replace, filedata) - if condition == 'r': - data_p = re.sub(re.compile(search, re.M), replace, filedata) - while data_p != filedata: - filedata = data_p - data_p = re.sub(re.compile(search, re.M), replace, filedata) - filedata = data_p - - # calll the last treatment to remove tabulation - filedata = re.sub(re.compile('\t', re.M), ' ', filedata) - - # Write file - write_file(dstfilepath, filedata) - - - -def change_file(srcfile, dstfile, filetype, mode): - - if os.path.exists(srcfile): - create_path(os.path.dirname(dstfile)) - - if os.path.exists(dstfile): - print 'already exists:',dstfile - if mode is True: - ask = "y" - else: - ask = "" - while (ask != "y") and (ask != "n"): - ask = raw_input('overwrite (y/n)? ') - - if ask == "y": - print 'overwrite:',dstfile - substitute_file(srcfile, dstfile, filetype) - - if ask == "n": - print 'stop overwrite::',dstfile - sys.exit(0) - - else: - print 'write: from',srcfile - print ' into',dstfile - substitute_file(srcfile, dstfile, filetype) - - else: - print 'error:',srcfile,'does not exist' - sys.exit(1) - - return; - - -def convert_file(file, plasma_src, prefix, mode): - srcpath = os.path.abspath(plasma_src) - dstpath = os.path.join(os.path.abspath(prefix),'') - - filename = os.path.basename(file) - filetype = file[:- len(filename)-1] - - srcfilepath = os.path.join(srcpath,file) - dstfilepath = os.path.join(dstpath,filetype) - - if filetype == 'core_blas': - # coreblas - dstpath_core = os.path.join(dstpath, 'coreblas/compute') - dstfilepath_core = os.path.join(dstpath_core, filename) - change_file(srcfilepath, dstfilepath_core, 'coreblas', mode) - change_file(dstfilepath_core, dstfilepath_core, 'all_end', True) - - elif filetype == 'core_blas-qwrapper': - - # coreblas path - dstpath_core = os.path.join(dstpath, 'coreblas/compute') - dstfilepath_core = os.path.join(dstpath_core, filename) - - if filename == 'qwrapper_zgetf2_nopiv.c' or \ - filename == 'qwrapper_zpemv.c' or \ - filename == 'qwrapper_zparfb.c': - print 'CODELET:', filename, 'do not need to be generated' - - else: - # codelet for quark - filename = filename.replace('qwrapper', 'codelet') - dstpath_quark = os.path.join(dstpath, 'runtime/quark/codelets') - dstfilepath_quark = os.path.join(dstpath_quark, filename) - change_file(srcfilepath, dstfilepath_quark, 'codelet_quark', mode) - - # codelet for starpu - filename = filename.replace('core', 'codelet') - dstpath_starpu = os.path.join(dstpath, 'runtime/starpu/codelets') - dstfilepath_starpu = os.path.join(dstpath_starpu, filename) - change_file(dstfilepath_quark, dstfilepath_starpu, 'codelet_starpu', mode) - - # codelet for starpu with WS - if filename == 'codelet_zgelqt.c' or \ - filename == 'codelet_zgeqrt.c' or \ - filename == 'codelet_ztslqt.c' or \ - filename == 'codelet_ztsmlq.c' or \ - filename == 'codelet_ztsmqr.c' or \ - filename == 'codelet_ztsqrt.c' or \ - filename == 'codelet_ztstrf.c' or \ - filename == 'codelet_zttlqt.c' or \ - filename == 'codelet_zttmlq.c' or \ - filename == 'codelet_zttmqr.c' or \ - filename == 'codelet_zttqrt.c' or \ - filename == 'codelet_zunmlq.c' or \ - filename == 'codelet_zunmqr.c': - change_file(dstfilepath_starpu, dstfilepath_starpu, 'codelet_starpu_ws', True) - - # codelet for starpu with cuda - if filename == 'codelet_zgemm.c' or \ - filename == 'codelet_zhemm.c' or \ - filename == 'codelet_zherk.c' or \ - filename == 'codelet_zher2k.c' or \ - filename == 'codelet_zsymm.c' or \ - filename == 'codelet_zsyrk.c' or \ - filename == 'codelet_zsyr2k.c' or \ - filename == 'codelet_ztrsm.c' or \ - filename == 'codelet_ztrmm.c' or \ - filename == 'codelet_zlauum.c' or \ - filename == 'codelet_ztrtri.c' or \ - filename == 'codelet_zpotrf.c': - change_file(dstfilepath_starpu, dstfilepath_starpu, 'codelet_starpu_cuda', True) - - change_file(dstfilepath_quark, dstfilepath_quark, 'all_end', True) - change_file(dstfilepath_starpu, dstfilepath_starpu, 'all_end', True) - - elif filetype == 'compute': - # drivers (2 treatments is necessary) - dstfilepath = os.path.join(dstfilepath,filename) - change_file(srcfilepath, dstfilepath, 'all_compute', mode) - - if filename[0:2] == 'pz': - change_file(dstfilepath, dstfilepath, 'pcompute', True) - - # specific transformation - if filename == 'pzgebrd_tb2bd.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzgetrf_reclap.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzgelqfrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzgeqrfrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzunglq.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzunglqrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzungqr.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzungqrrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzunmlqrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - if filename == 'pzunmqrrh.c': - change_file(dstfilepath, dstfilepath, filename, True) - - # specific transformation to add workspace - if filename == 'pzgelqf.c' or \ - filename == 'pzgelqfrh.c' or \ - filename == 'pzgeqrf.c' or \ - filename == 'pzgeqrfrh.c' or \ - filename == 'pzgetmi2.c' or \ - filename == 'pzgetrf_incpiv.c' or \ - filename == 'pzhetrd_hb2st.c' or \ - filename == 'pzlange.c' or \ - filename == 'pzlanhe.c' or \ - filename == 'pzlansy.c' or \ - filename == 'pzpack.c' or \ - filename == 'pzshift.c' or \ - filename == 'pzunglq.c' or \ - filename == 'pzunglqrh.c' or \ - filename == 'pzungqr.c' or \ - filename == 'pzungqrrh.c' or \ - filename == 'pzunmlq.c' or \ - filename == 'pzunmlqrh.c' or \ - filename == 'pzunmqr_blgtrd.c' or \ - filename == 'pzunmqr.c' or \ - filename == 'pzunmqrrh.c': - # codelet for starpu - change_file(dstfilepath, dstfilepath, 'pcompute_ws', True) - - else: - change_file(dstfilepath, dstfilepath, 'compute', True) - - change_file(dstfilepath, dstfilepath, 'all_end', True) - - elif filetype == 'include': - if filename == 'core_zblas.h' or filename == 'core_zcblas.h': - # include for coreblas - filetype = 'include_coreblas' - dstfilename = filename.replace('core_', 'coreblas_') - dstfilename = dstfilename.replace('blas.h', '.h') - dstfilepath = os.path.join(dstpath,'coreblas/include') - dstfilepath = os.path.join(dstfilepath,dstfilename) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - # include for runtime (insert_task) - filetype = 'include_runtime' - dstfilepath = os.path.join(dstpath,'include') - newfile = re.sub('core', 'runtime', filename) - newfile = re.sub('blas', '', newfile) - dstfilepath = os.path.join(dstfilepath,newfile) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - # include quark_blas - filetype = 'include_quarkblas' - dstfilepath = os.path.join(dstpath,'runtime/quark/include') - newfile = re.sub('core', 'quark', filename) - dstfilepath = os.path.join(dstfilepath,newfile) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - elif filename == 'plasma_z.h' or filename == 'plasma_zc.h': - # include for drivers - filetype = 'include_morse' - dstfilepath = os.path.join(dstpath,'include') - newfile = re.sub('plasma', 'morse', filename) - dstfilepath = os.path.join(dstfilepath,newfile) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - else: - print '% >>>>>>>>>>>>>>>>>>>>>>>>>>>' - print '% What do you think you do...' - print '% <<<<<<<<<<<<<<<<<<<<<<<<<<<' - sys.exit(1) - - elif filetype == 'control': - newfile = re.sub('plasma', 'morse', filename) - dstfilepath = os.path.join(dstfilepath,newfile) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - else: - # others files (timing, testing...) - dstfilepath = os.path.join(dstfilepath,filename) - change_file(srcfilepath, dstfilepath, filetype, mode) - change_file(dstfilepath, dstfilepath, 'all_end', True) - - return; diff --git a/plasma-conversion/fileCopy.py b/plasma-conversion/fileCopy.py deleted file mode 100644 index 6bbbc41af1ec9b51216ed98f438890adbb515507..0000000000000000000000000000000000000000 --- a/plasma-conversion/fileCopy.py +++ /dev/null @@ -1,117 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- -### -# -# -- Inria -# -- (C) Copyright 2012 -# -# This software is a computer program whose purpose is to process -# Matrices Over Runtime Systems @ Exascale (MORSE). More information -# can be found on the following website: http://www.inria.fr/en/teams/morse. -# -# This software is governed by the CeCILL-C license under French law and -# abiding by the rules of distribution of free software. You can use, -# modify and/ or redistribute the software under the terms of the CeCILL-C -# license as circulated by CEA, CNRS and INRIA at the following URL -# "http://www.cecill.info". -# -# As a counterpart to the access to the source code and rights to copy, -# modify and redistribute granted by the license, users are provided only -# with a limited warranty and the software's author, the holder of the -# economic rights, and the successive licensors have only limited -# liability. -# -# In this respect, the user's attention is drawn to the risks associated -# with loading, using, modifying and/or developing or reproducing the -# software by the user in light of its specific status of free software, -# that may mean that it is complicated to manipulate, and that also -# therefore means that it is reserved for developers and experienced -# professionals having in-depth computer knowledge. Users are therefore -# encouraged to load and test the software's suitability as regards their -# requirements in conditions enabling the security of their systems and/or -# data to be ensured and, more generally, to use and operate it in the -# same conditions as regards security. -# -# The fact that you are presently reading this means that you have had -# knowledge of the CeCILL-C license and that you accept its terms. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2016-08-17 -# -### - -import sys; -import os; -import shutil; -import string; - - -def copyDirectoryTree(directory, destination, mode): - pattern = shutil.ignore_patterns('.svn', '*~', 'plasma-conversion', 'insert-licence') - for entry in os.listdir(directory): - entryPath = os.path.join(directory, entry) - destPath = os.path.join(destination, entry) - if os.path.isdir(entryPath): - if entry == '.svn' or \ - entry == 'insert-licence' or \ - entry == 'plasma-conversion': - continue - else: - if os.path.exists(destPath): - copyDirectoryTree(entryPath, destPath, mode) - - else: - print 'write:',destPath - shutil.copytree(entryPath, destPath, ignore=pattern) - - else: - #if not os.path.exists(destPath): - if entry == 'plasma_2.6.0.tar.gz': - continue - else: - print 'write:',destPath - shutil.copy(entryPath, destination) - #else: - #print 'not write:',destPath - #print 'already exists:',destPath - #if mode is True: - # ask = "y" - - #else: - # ask = "" - - #while (ask != "y") and (ask != "n"): - # ask = raw_input('overwrite (y/n)? ') - - #if ask == "y": - # print 'overwrite:',destPath - # shutil.copy(entryPath, destination) - - #if ask == "n": - # print 'stop overwrite:',destPath - # sys.exit(0) - - -def copy_file(srcpath, dstpath, mode): - - if os.path.exists(srcpath) is True: - dstpath2 = os.path.join(dstpath, '') - copyDirectoryTree(srcpath, dstpath2, mode) - - else: - print 'error:',srcpath,'does not exist' - sys.exit(1) - - return; diff --git a/plasma-conversion/generate_morseSrc.py b/plasma-conversion/generate_morseSrc.py deleted file mode 100755 index 914f9f4d18b577f46349b0f495d289cd1f8eb52e..0000000000000000000000000000000000000000 --- a/plasma-conversion/generate_morseSrc.py +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- -### -# -# -- Inria -# -- (C) Copyright 2012 -# -# This software is a computer program whose purpose is to process -# Matrices Over Runtime Systems @ Exascale (MORSE). More information -# can be found on the following website: http://www.inria.fr/en/teams/morse. -# -# This software is governed by the CeCILL-C license under French law and -# abiding by the rules of distribution of free software. You can use, -# modify and/ or redistribute the software under the terms of the CeCILL-C -# license as circulated by CEA, CNRS and INRIA at the following URL -# "http://www.cecill.info". -# -# As a counterpart to the access to the source code and rights to copy, -# modify and redistribute granted by the license, users are provided only -# with a limited warranty and the software's author, the holder of the -# economic rights, and the successive licensors have only limited -# liability. -# -# In this respect, the user's attention is drawn to the risks associated -# with loading, using, modifying and/or developing or reproducing the -# software by the user in light of its specific status of free software, -# that may mean that it is complicated to manipulate, and that also -# therefore means that it is reserved for developers and experienced -# professionals having in-depth computer knowledge. Users are therefore -# encouraged to load and test the software's suitability as regards their -# requirements in conditions enabling the security of their systems and/or -# data to be ensured and, more generally, to use and operate it in the -# same conditions as regards security. -# -# The fact that you are presently reading this means that you have had -# knowledge of the CeCILL-C license and that you accept its terms. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2016-08-17 -# -### - -import sys; -import shutil; -from optparse import OptionParser,OptionGroup; - -from fileConversion import *; -from fileCopy import *; - -def main(argv): - - # Create the options parser for detecting options on the command line. - parser = OptionParser(usage="Usage: %prog [options]"); - group = OptionGroup(parser,"Printing Options","These options control generate_morseSrc.py."); - group.add_option("-y","--force" , help=': Force overwrite all files' , action='store_true', dest='force' , default=False); - group.add_option("-o","--prefix" , help=': install files in PREFIX.' , action='store' , dest='prefix' , type='string', default=False); - group.add_option("-p","--plasma-dir", help=': Specify the top directory of PLASMA.' , action='store' , dest='pdir' , type='string', default=False); - group.add_option("-m","--morse-dir" , help=': Specify the top directory of CHAMELEON.' , action='store' , dest='mdir' , type='string', default=False); - group.add_option("-f","--file" , help=': Specify a file(s) on which to operate.', action='store' , dest='flist' , type='string', default=False); - parser.add_option_group(group); - (options, args) = parser.parse_args(); - - # Create files from PLASMA - if options.prefix and options.pdir and options.flist: - print '\n#####################' - print '\nCONVERT PLASMA FILES ' - print '\n#####################' - for file in options.flist.split(): - convert_file(file, options.pdir, options.prefix, options.force) - - # Copy file from CHAMELEON - if options.prefix and options.mdir: - print '\n#####################' - print '\nCOPY NEEDED SVN CHAMELEON' - print '\n#####################' - copy_file(options.mdir, options.prefix, options.force) - - # Exit - return 0 - -if "__main__" == __name__: - sys.exit(main(sys.argv)) diff --git a/plasma-conversion/insert-licence/chameleon_c.licence b/plasma-conversion/insert-licence/chameleon_c.licence deleted file mode 100644 index 6850947fb41c1de0149ce1d786e48a6ff13fa1ac..0000000000000000000000000000000000000000 --- a/plasma-conversion/insert-licence/chameleon_c.licence +++ /dev/null @@ -1,10 +0,0 @@ -/** - * - * @file chameleon_c.licence - * - * @copyright 2009-2015 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - **/ diff --git a/plasma-conversion/insert-licence/chameleon_f.licence b/plasma-conversion/insert-licence/chameleon_f.licence deleted file mode 100644 index c80f5466dee0da26bf56b06ab34ec7512a9006cc..0000000000000000000000000000000000000000 --- a/plasma-conversion/insert-licence/chameleon_f.licence +++ /dev/null @@ -1,9 +0,0 @@ -!!! -! -! @copyright 2009-2015 The University of Tennessee and The University -! of Tennessee Research Foundation. All rights reserved. -! @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, -! Univ. Bordeaux. All rights reserved. -! -!!! - diff --git a/plasma-conversion/insert-licence/insert-licence-chameleon.sh b/plasma-conversion/insert-licence/insert-licence-chameleon.sh deleted file mode 100755 index 9df8a039c066867c712c74e563bc5fd997a04741..0000000000000000000000000000000000000000 --- a/plasma-conversion/insert-licence/insert-licence-chameleon.sh +++ /dev/null @@ -1,69 +0,0 @@ -#!/bin/bash -### -# -# -- Inria -# -- (C) Copyright 2016 -# -# This software is a computer program whose purpose is to process -# Matrices Over Runtime Systems @ Exascale (MORSE). More information -# can be found on the following website: http://www.inria.fr/en/teams/morse. -# -# This software is governed by the CeCILL-C license under French law and -# abiding by the rules of distribution of free software. You can use, -# modify and/ or redistribute the software under the terms of the CeCILL-C -# license as circulated by CEA, CNRS and INRIA at the following URL -# "http://www.cecill.info". -# -# As a counterpart to the access to the source code and rights to copy, -# modify and redistribute granted by the license, users are provided only -# with a limited warranty and the software's author, the holder of the -# economic rights, and the successive licensors have only limited -# liability. -# -# In this respect, the user's attention is drawn to the risks associated -# with loading, using, modifying and/or developing or reproducing the -# software by the user in light of its specific status of free software, -# that may mean that it is complicated to manipulate, and that also -# therefore means that it is reserved for developers and experienced -# professionals having in-depth computer knowledge. Users are therefore -# encouraged to load and test the software's suitability as regards their -# requirements in conditions enabling the security of their systems and/or -# data to be ensured and, more generally, to use and operate it in the -# same conditions as regards security. -# -# The fact that you are presently reading this means that you have had -# knowledge of the CeCILL-C license and that you accept its terms. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @author Florent Pruvost -# @date 2016-08-17 -# -### -for i in $(find . -name "*.c" -or -name "*.h" -not -path "*svn*" -not -name "chameleon_fortran.h") -do - cat $(dirname $0)/chameleon_c.licence > $(dirname $0)/buffer.tmp - cat $i >> $(dirname $0)/buffer.tmp - cat $(dirname $0)/buffer.tmp > $i - rm $(dirname $0)/buffer.tmp -done - -for i in $(find . -name "*.f" -or -name "*.F" -or -name "*.f77" -or -name "*.F77" -or -name "*.f90" -or -name "*.F90" -or -name "chameleon_fortran.h") -do - cat $(dirname $0)/chameleon_f.licence > $(dirname $0)/buffer.tmp - cat $i >> $(dirname $0)/buffer.tmp - cat $(dirname $0)/buffer.tmp > $i - rm $(dirname $0)/buffer.tmp -done diff --git a/plasma-conversion/rulesSubstitutions.py b/plasma-conversion/rulesSubstitutions.py deleted file mode 100644 index a772d5d0637e38f6da719b03c1334e8b185ca364..0000000000000000000000000000000000000000 --- a/plasma-conversion/rulesSubstitutions.py +++ /dev/null @@ -1,704 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- -### -# -# -- Inria -# -- (C) Copyright 2012 -# -# This software is a computer program whose purpose is to process -# Matrices Over Runtime Systems @ Exascale (MORSE). More information -# can be found on the following website: http://www.inria.fr/en/teams/morse. -# -# This software is governed by the CeCILL-C license under French law and -# abiding by the rules of distribution of free software. You can use, -# modify and/ or redistribute the software under the terms of the CeCILL-C -# license as circulated by CEA, CNRS and INRIA at the following URL -# "http://www.cecill.info". -# -# As a counterpart to the access to the source code and rights to copy, -# modify and redistribute granted by the license, users are provided only -# with a limited warranty and the software's author, the holder of the -# economic rights, and the successive licensors have only limited -# liability. -# -# In this respect, the user's attention is drawn to the risks associated -# with loading, using, modifying and/or developing or reproducing the -# software by the user in light of its specific status of free software, -# that may mean that it is complicated to manipulate, and that also -# therefore means that it is reserved for developers and experienced -# professionals having in-depth computer knowledge. Users are therefore -# encouraged to load and test the software's suitability as regards their -# requirements in conditions enabling the security of their systems and/or -# data to be ensured and, more generally, to use and operate it in the -# same conditions as regards security. -# -# The fact that you are presently reading this means that you have had -# knowledge of the CeCILL-C license and that you accept its terms. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2016-08-17 -# -### - -subs = { - # -------------------------------------------------------- - # replacements applied to ALL files first. - 'all_begin' : [ - ( 'u', None, None ), - ], - - # ------------------------------------------------------------ - # replacements applied to compute files. - 'all_compute' : [ - # Get information in static function to allocate workspace - ( 'r', '#include([\s\S]*)plasma_private_alloc\(([^,]*),([\s\S]*?),([^)]*)\)', '//WS_ALLOC : \\3\n#include\\1' ), - # end get - - ( 'u', 'plasma_static_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([^;]*);', 'chameleon_\\3(,\\4;' ), - ( 'u', 'plasma_dynamic_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([^;]*);', 'chameleon_\\3(,\\4;' ), - ( 'u', 'plasma_parallel_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([^;]*);', 'chameleon_\\3(,\\4;' ), - ( 'u', 'plasma_static_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([\s\S]*?)request\)', 'chameleon_\\3(,\\4)' ), - ( 'u', 'plasma_dynamic_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([\s\S]*?)request\)', 'chameleon_\\3(,\\4)' ), - ( 'u', 'plasma_parallel_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([\s\S]*?)request\)', 'chameleon_\\3(,\\4)' ), - # Dirty replacement to put the correct call of 'chameleon_pz***` by removing all types - # The 8 first lines are called n times more to be sure to change all `plasma_desc_mat_free(&desc` to `RUNTIME_desc_getoncpu(` - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)PLASMA_enum([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)PLASMA_desc([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)PLASMA_Complex64_t([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)PLASMA_sequence([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)PLASMA_request([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)int([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)float([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - ( 'r', 'chameleon_p([\w]*)\(([^;]*),([\s\w]*)double([ \w\*]*),([^;]*);', 'chameleon_p\\1(\\2,\\5;' ), - - ( 'u', 'chameleon_p([\w]*)\(([, ]*)', 'chameleon_p\\1(' ), - ], - # - # - 'compute' : [ - # Check the 2 next lines when plasma const will be right - ( 'u', 'OUTOFPLACE([^}]+)plasma_zooptile2lap\(([\s]*)([^,]+),([^}]+)plasma_dynamic_sync\(\);([\s]*)plasma_desc_mat_free([^}]+)}', - 'OUTOFPLACE\\1chameleon_zooptile2lap(\\3,\\4RUNTIME_barrier(morse);\\5RUNTIME_desc_getoncpu(&\\3);\\5plasma_desc_mat_free\\6}' ), - ( 'u', 'OUTOFPLACE([^}]+)RUNTIME_desc_getoncpu([^;]+);([\s]*)([^}]+)}([\s\S]*)_Tile\(([\s\S]*)plasma_dynamic_sync\(\);([\s]*)status = sequence->status', - 'OUTOFPLACE\\1RUNTIME_desc_getoncpu\\2;\\4}\\5_Tile(\\6RUNTIME_barrier(morse);\\7\\4\\7status = sequence->status' ), - # Dirty replacement for CHAMELEON_z*_Tile to put RUNTIME_desc_getoncpu - # The two first lines are called 10 times more to be sure to change all `plasma_desc_mat_free(&desc` to `RUNTIME_desc_getoncpu(` - ( 'r', '_Tile\(([\s\S]*)RUNTIME_barrier\(morse\);([^}]*)plasma_desc_mat_free\(&desc([^}]*)status = sequence->status', - '_Tile(\\1RUNTIME_barrier(morse);\\2RUNTIME_desc_getoncpu(\\3status = sequence->status' ), - - # Specific change for zplghe.c, zplgsy.c, zplrnt.c - # TODO: it works because it is the last call in the function - # we need to find better delimiters - ( 'u', '_zplghe\(([\s\S]*)\n([ \t]*)plasma_ziptile2lap\(([^;]*);', - '_zplghe(\\1\n\\2RUNTIME_barrier(morse);\n\\2chameleon_zooptile2lap(\\3;' ), - ( 'u', '_zplgsy\(([\s\S]*)\n([ \t]*)plasma_ziptile2lap\(([^;]*);', - '_zplgsy(\\1\n\\2RUNTIME_barrier(morse);\n\\2chameleon_zooptile2lap(\\3;' ), - ( 'u', '_zplrnt\(([\s\S]*)\n([ \t]*)plasma_ziptile2lap\(([^;]*);', - '_zplrnt(\\1\n\\2RUNTIME_barrier(morse);\n\\2chameleon_zooptile2lap(\\3;' ), - # end specific - - # Remove INPLACE / OUTOFPLACE - ( 'u', '\n([^\n]*)OUTOFPLACE([^\n]*)\n([\s\S]*?)\n([^\n]*)else([^\n]*)\n([\s\S]*?)\n([^\n]*)}([^\n]*)\n', - '\n/*\\1OUTOFPLACE\\2*/\n\\3\n/*\\4else\\5*/\n\\6\n/*\\7}\\8*/\n' ), - ( 'r', '\n([^\n]*?)OUTOFPLACE([^}]*?)}([\s]*)else([^}]*?)\n([ ])([^\n]*?)\n([^}]*?)}', - '\n\\1OUTOFPLACE\\2} else\\4\n/*\\5\\6*/\n\\7}' ), - ( 'u', '\n([ ]+)([\s]*)plasma_ziptile2lap([^;]*);([ \t]*)\n', '\n/*\\1\\2plasma_ziptile2lap\\3;\\4*/\n' ), - ( 'u', '\n([ ]+)([\s]*)plasma_ziplap2tile([^;]*);([ \t]*)\n', '\n/*\\1\\2plasma_ziplap2tile\\3;\\4*/\n' ), - # end remove - - # Change plasma_desc_init into chameleon_zdesc_alloc - ( 'u', 'desc([\w]*)([ \t]*)=([ \t]*)plasma_desc_init\(([^,]*),([^;]*);([\s]*)([^;]*);', 'chameleon_zdesc_alloc(desc\\1,\\5;' ), - ( 'u', 'chameleon_zdesc_alloc\(([^;]*),([\w\s]*)\*([\w\s]*),([^;]*);', 'chameleon_zdesc_alloc(\\1,\\4;' ), - ( 'u', 'chameleon_zdesc_alloc\(([^;]*)\n([ \t]*)([^;]*);', 'chameleon_zdesc_alloc(\\1 \\3;' ), - ( 'u', 'chameleon_zdesc_alloc\(desc([\w]*)([^;]*)\);', 'chameleon_zdesc_alloc(desc\\1\\2, chameleon_desc_mat_free(&desc\\1));' ), - # end chhange - - # Remove desc in Async - ( 'u', 'desc([\w]*)\.d', '\\1->d' ), - ( 'u', 'desc([\w]*)\.i', '\\1->i' ), - ( 'u', 'desc([\w]*)\.j', '\\1->j' ), - ( 'u', 'desc([\w]*)\.l', '\\1->l' ), - ( 'u', 'desc([\w]*)\.m', '\\1->m' ), - ( 'u', 'desc([\w]*)\.n', '\\1->n' ), - ( 'r', '_Tile_Async\(([\s\S]*)\n([ \t]*)PLASMA_desc([ \t]*)([\w]*);([ \t]*)\n([\s\S]*)\n}\n', - '_Tile_Async(\\1\n\\6\n}\n' ), - ( 'r', '_Tile_Async\(([\s\S]*)\n([ \t]*)desc([\w]*)([ \t]*)=([ \t]*)\*\\3;([ \t]*)\n([\s\S]*)\n}\n', - '_Tile_Async(\\1\n\\7\n}\n' ), - ( 'r', '_Tile_Async\(([\s\S]*)\n([ \t]*)}([ \t]*)else([ \t]*){([\s]*)}([ \t]*)\n([\s\S]*)\n}\n' , - '_Tile_Async(\\1\n\\2}\n\\7\n}\n' ), - ( 'r', '_Tile_Async\(([\s\S]*)chameleon_p([\w]*)\(([^;]*)desc([a-zA-Z0-9]+)([^;]*);([\s\S]*)\n}\n' , - '_Tile_Async(\\1chameleon_p\\2(\\3\\4\\5;\\6\n}\n' ), - # end remove - - # Patch for chameleon_desc_submatrix (this will not work with 2-sided and LU inversion) - ( 'r', '_Tile_Async\(([\s\S]*)^([\s]*)chameleon_p([\w]*)\(([^;]*)plasma_desc_submatrix\(([\s]*)([a-zA-Z0-9]+),([\s\S]*)\),([^;]*);', - '_Tile_Async(\\1\\2sub\\6 = chameleon_desc_submatrix(\\5\\6,\\7);\n\\2chameleon_p\\3(\\4sub\\6,\\8;\n\\2free(sub\\6);' ), - ( 'r', '_Tile_Async\(([^)]*)\)([\s]*){([\s\S]*)free\(sub([\w]*)\)', - '_Tile_Async(\\1)\\2{\n\tCHAM_desc_t *sub\\4;\\3FLAGFREE(sub\\4)' ), - ( 'r', '_Tile_Async\(([^)]*)\)([\s]*){([\s\S]*)CHAM_desc_t \*sub([\w]*);([\s\S]*)\n^([\s]*)CHAM_desc_t \*sub\\4;', - '_Tile_Async(\\1)\\2{\\3CHAM_desc_t *sub\\4;\\5' ), - ( 'u', 'FLAGFREE', 'free' ), - # end patch - - ( 'u', 'PLASMA_Dealloc_Handle_Tile', 'CHAMELEON_Dealloc_Workspace' ), - ( 'u', 'plasma_dynamic_sync\(\)', 'RUNTIME_barrier(morse)' ), - ( 'u', 'QUARK_Barrier\(plasma->quark\)', 'RUNTIME_barrier(morse)' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'plasma_context_t', 'CHAM_context_t' ), - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - - # Fix for zgels et zgelqs - ( 'u', 'CHAMELEON_zgels_Tile_Async([\s\S]*)sub([\w]*) = ([\s\S]*?)chameleon_pztile_zero([\s\S]*?)free([^;]*);', - 'CHAMELEON_zgels_Tile_Async\\1/* sub\\2 = \\3chameleon_pztile_zero\\4free\\5; */' ), - ( 'u', 'CHAMELEON_zgelqs_Tile_Async([\s\S]*)sub([\w]*) = ([\s\S]*?)chameleon_pztile_zero([\s\S]*?)free([^;]*);', - 'CHAMELEON_zgelqs_Tile_Async\\1/* sub\\2 = \\3chameleon_pztile_zero\\4free\\5; */' ), - - ], - - # ------------------------------------------------------------ - # replacements applied to pcompute files. - 'pcompute' : [ - ( 'u', '#if 0([\s\S]*?)#endif', '' ), - ( 'u', 'plasma_([\w]*)_quark\(', 'chameleon_\\1(' ), - ( 'u', '\*\*/([\s]*?)void([\s]*?)plasma_([\w]*?)\(([\s\S]*)}([\s]*?)/\*\*', '**/\\1\n/**' ), - ( 'u', 'static scheduling([\s\S]*)dynamic scheduling', 'dynamic scheduling' ), - - ( 'u', 'Quark_Task_Flags task_flags([\w]*) = Quark_Task_Flags_Initializer;', 'RUNTIME_option_t options\\1;' ), - ( 'u', 'QUARK_Task_Flag_Set\(([\s\S]*?)task_flags([\w]*)([\s]*),([^\n]*)\);', 'RUNTIME_options_init(&options\\2, morse, sequence, request);' ), - ( 'u', 'plasma->quark, &task_flags([\w]*)', '&options\\1' ), - ( 'u', 'RUNTIME_options_init\(&options([\w]*),([\s\S]*)}', - 'RUNTIME_options_init(&options\\1,\\2\tRUNTIME_options_finalize(&options\\1, morse);\n}' ), - - ( 'u', 'plasma_dynamic_sync\(\)', 'RUNTIME_barrier(morse)' ), - ( 'u', 'QUARK_Barrier\(plasma->quark\)', 'RUNTIME_barrier(morse)' ), - - ( 'u', 'PLASMA_desc([ \t]*)', 'CHAM_desc_t\\1*' ), - ( 'u', 'plasma_context_t', 'CHAM_context_t' ), - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'QUARK_CORE', 'CHAMELEON_TASK' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - ( 'u', '_quark', '' ), - - ( 'u', 'CHAMELEON_TASK([\w]*)\(([^;]*),([ \n\t]*)sequence([^;]*);', 'CHAMELEON_TASK\\1(\\2\\4;' ), - ( 'u', 'CHAMELEON_TASK([\w]*)\(([^;]*),([ \n\t]*)request([^;]*);', 'CHAMELEON_TASK\\1(\\2\\4;' ), - ( 'u', '#define([\w\s]*)\(([\w\s]*),([\w\s]*)\)([ \t]*)BLKADDR\(([\S\s]*?),([\S\s]*?),([\S\s]*?),([\S\s]*?)\)\n', - '#define\\1(\\2,\\3) \\5, \\7, \\8\n' ), - - ( 'u', '([\w]*)\.d', '\\1->d' ), - ( 'u', '([\w]*)\.i', '\\1->i' ), - ( 'u', '([\w]*)\.j', '\\1->j' ), - ( 'u', '([\w]*)\.l', '\\1->l' ), - ( 'u', '([\w]*)\.m', '\\1->m' ), - ( 'u', '([\w]*)\.n', '\\1->n' ), - ], - # - # - # specific patch because of dirty source code - 'pzgebrd_tb2bd.c' : [ - ( 'u', '#define A\(_m, _n\) \(CHAMELEON_Complex64_t \*\)chameleon_geteltaddr\(&A, \(_m\), \(_n\), eltsize\)', - '#define A(_m,_n) BLKADDR(&dA, CHAMELEON_Complex64_t, _m, _n)' ), - ], - 'pzgetrf_reclap.c' : [ - ( 'u', '#define BLKLDD\(&dA, k\) \(A\)d.lm', '#define BLKLDD(dA, k) (dA).lm' ), - ( 'u', 'BLKLDD\(&dA', 'BLKLDD(dA' ), - ], - # - # - # Need to add specific information - not static implementation - 'pzgelqfrh.c' : [ - ( 'u', '#include "common.h"', '//WS_ALLOC : A->nb + ib*T->nb\n#include "common.h"' ), - ], - 'pzgeqrfrh.c' : [ - ( 'u', '#include "common.h"', '//WS_ALLOC : A->nb + ib*T->nb\n#include "common.h"' ), - ], - 'pzunglq.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - 'pzunglqrh.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - 'pzungqr.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - 'pzungqrrh.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - 'pzunmlqrh.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - 'pzunmqrrh.c': [ - ( 'u', '#include "common.h"', '//WS_ALLOC : ib*T->nb\n#include "common.h"' ), - ], - - # end specific patch - - # ------------------------------------------------------------ - # replacements applied to pcompute files - (workspace) - 'pcompute_ws' : [ - # Compute the size of the workspace - ( 'u', '#include "common.h"', '//WS_ADD : \n#include "common.h"' ), - ( 'u', '//WS_ALLOC : ([^\n]*)\n([\s\S]*?)//WS_ADD : ([^\n]*)\n', '//ALLOC_WS : \\1\n\\2//WS_ADD : \\3\\1\n' ), - ( 'r', '//WS_ALLOC : ([^\n]*)\n([\s\S]*?)//WS_ADD : ([^\n]*)\n', '//ALLOC_WS : \\1\n\\2//WS_ADD : \\3 +\\1\n' ), - # end compute - ( 'u', '([\s\S]*?)WS_ADD : ([^\n]*)\n([\s\S]*?)^([\s]*)ib([\s]*)=([\s]*)CHAMELEON_IB([\s]*);', - '\\1WS_ADD : \\2\n\\3\\4ib\\5=\\6CHAMELEON_IB\\7;\\4h_work_size = sizeof(CHAMELEON_Complex64_t)*(\\2 );\\4d_work_size = 0;\\4RUNTIME_options_ws_alloc( &options, h_work_size, d_work_size );\n' ), - ( 'u', 'RUNTIME_options_finalize\(&options, morse\);', 'RUNTIME_options_ws_free(&options);\n\tRUNTIME_options_finalize(&options, morse);' ), - ( 'u', 'RUNTIME_option_t options;', 'RUNTIME_option_t options;\n\tsize_t h_work_size, d_work_size;' ), - ], - - # ------------------------------------------------------------ - # replacements applied to coreblas files. - 'coreblas' : [ - ( 'u', '#include "common.h"', '#include "coreblas.h"' ), - ( 'u', '#include "quark.h"', '' ), - ( 'u', '#if defined\(PLASMA_HAVE_WEAK\)([\s\S]*?)#endif', '' ), - ( 'u', 'int([\s]*)QUARK_CORE_([\w]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', 'void([\s]*)QUARK_CORE_([\w]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', 'void([\s]*)CORE([\w]*)_quark\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', 'BLKADDR\(([ ]*)([\w]*),([^\n]*)', 'BLKADDR(&\\2,\\3' ), - ( 'u', 'BLKLDD\(([ ]*)([\w]*)([^\n]*)', 'BLKLDD(&\\2\\3' ), - - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'PLASMA_Complex64_t', 'CHAMELEON_Complex64_t' ), - ( 'u', 'PLASMA_Complex32_t', 'CHAMELEON_Complex32_t' ), - ( 'u', 'PLASMA_enum', 'CHAMELEON_enum' ), - ( 'u', 'PLASMA_CORE', 'CHAMELEON_CORE' ), - ( 'u', 'PLASMA_SUCCESS', 'CHAMELEON_SUCCESS' ), - ( 'u', 'PLASMA_ERR_NOT_SUPPORTED', 'CHAMELEON_ERR_NOT_SUPPORTED' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - - ( 'u', '/([\s\\*]*)/\n\n', '' ), - ], - - # ------------------------------------------------------------ - # replacements applied to codelet_quark files. - 'codelet_quark' : [ - ( 'u', '#include "common.h"', '#include "chameleon_quark.h"' ), - ( 'u', '#if defined\(PLASMA_HAVE_WEAK\)([\s\S]*?)#endif', '' ), - - ( 'u', '\n([\s\w]*)void([\s]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', '\n([\s\w]*)int([\s]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', '\n([\s\w]*)void([\s]*)CORE_([\w]*)_([^q])([a-zA-Z0-9]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', '\n([\s\w]*)int([\s]*)CORE_([\w]*)_([^q])([a-zA-Z0-9]*)\(([^)]*)\)([\s]*){([\s\S]*?)\n}', '' ), - ( 'u', '\n([\s\w]*)void([\s]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\);', '' ), - ( 'u', '\n([\s\w]*)int([\s]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\);', '' ), - ( 'u', '\n([\s\w]*)void([\s]*)CORE_([\w]*)_([^q])([a-zA-Z0-9]*)\(([^)]*)\);', '' ), - ( 'u', '\n([\s\w]*)int([\s]*)CORE_([\w]*)_([^q])([a-zA-Z0-9]*)\(([^)]*)\);', '' ), - - ( 'u', 'Quark([\s]*)\*quark,([\s]*)Quark_Task_Flags([\s]*)\*task_flags,', 'RUNTIME_option_t *options,' ), - ( 'u', 'plasma_sequence_flush', 'RUNTIME_sequence_flush' ), - ( 'u', 'QUARK_Insert_Task\(([ \t\n]*)quark', 'QUARK_Insert_Task(\\1options->quark' ), - ( 'u', 'QUARK_Insert_Task\(([^)]*)task_flags', 'QUARK_Insert_Task(\\1options->task_flags' ), - ( 'u', '&sequence,', '&(options->sequence),' ), - ( 'u', '&request,', '&(options->request),' ), - - ( 'u', '\(([\s\S]*),([\s]*)PLASMA_sequence([^,]*)sequence', '(\\1' ), - ( 'u', '\(([\s\S]*),([\s]*)PLASMA_request([^,]*)request', '(\\1' ), - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - - ( 'u', 'static inline \n', '' ), - ( 'u', 'static \n', '' ), - - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)const ([ \t\w]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2\\3*\\4,' ), - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)PLASMA_Complex64_t([ \t]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2CHAM_desc_t *\\4, int \\4m, int \\4n,' ), - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)PLASMA_Complex32_t([ \t]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2CHAM_desc_t *\\4, int \\4m, int \\4n,' ), - ( 'r', 'QUARK_Insert_Task\(([^;]*)sizeof\(PLASMA_Complex64_t\)\*([\s\S]*?),([\s]*)([\w]*),', - 'QUARK_Insert_Task(\\1sizeof(CHAMELEON_Complex64_t)*\\2,\\3RTBLKADDR(\\4, CHAMELEON_Complex64_t, \\4m, \\4n),' ), - ( 'r', 'QUARK_Insert_Task\(([^;]*)sizeof\(PLASMA_Complex32_t\)\*([\s\S]*?),([\s]*)([\w]*),', - 'QUARK_Insert_Task(\\1sizeof(CHAMELEON_Complex32_t)*\\2,\\3RTBLKADDR(\\4, CHAMELEON_Complex32_t, \\4m, \\4n),' ), - ( 'u', 'RTBLKADDR\(NULL, CHAMELEON_Complex64_t, NULLm, NULLn\)' , 'NULL' ), - - ( 'u', 'QUARK_CORE', 'CHAMELEON_TASK' ), - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - - ( 'u', 'qwrapper_([\w]*).c', 'codelet_\\1.c' ), - ( 'u', 'core_blas quark wrapper', 'codelets kernel' ), - - # Add patch to remove REGION_D and REGION_U in codelet_zttlqt.c + codelet_zttqrt.c - ( 'r', 'QUARK_Insert_Task\(([^;]*)CORE_zttqrt_quark([^;]*)\|([\s]*)QUARK_REGION_D([\s]*)\|([\s]*)QUARK_REGION_U', - 'QUARK_Insert_Task(\\1CORE_zttqrt_quark\\2' ), - ( 'r', 'QUARK_Insert_Task\(([^;]*)CORE_zttlqt_quark([^;]*)\|([\s]*)QUARK_REGION_D([\s]*)\|([\s]*)QUARK_REGION_L', - 'QUARK_Insert_Task(\\1CORE_zttlqt_quark\\2' ), - # end patch - - # Suppress additional functions (ex: gemm2, gemm_f2...) - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CORE_zgemm_([\w]+)_quark\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CHAMELEON_TASK_zgemm_([\w]+)\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CORE_zgemm([0-9]+)_quark\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CHAMELEON_TASK_zgemm([0-9]+)\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CORE_ztrmm_([\w]+)_quark\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '\n([\s\w]*)([\w]*)([\s]*)CHAMELEON_TASK_ztrmm_([\w]+)\(([^)]*)\)([\s]*){([\s\S]*?)\n}' , '' ), - ( 'u', '/\*([\s\*]*)\*/([\s]*)/\*([\s\*]*)\*/\n' , '' ), - # end suppress - - # Special remove of Rnd64_jump - ( 'u', '#define COMPLEX([\s\S]*)static unsigned long long int([\s]*)Rnd64_jump([\s\S]*)return([\s\w]*);([\s]*)}', '' ), - # end remove - ], - - # ------------------------------------------------------------ - # replacements applied to codelet_starpu files. - 'codelet_starpu' : [ - # Transformation for cl_***_cpu_func - ( 'u', '#include "chameleon_quark.h"', '#include "chameleon_starpu.h"' ), - ( 'u', 'void([ \t]*)CORE_([\w]*)_quark\(([^)]*)\)', 'static void cl_\\2_cpu_func(void *descr[], void *cl_arg)' ), - ( 'u', '\n([ \t]*)RUNTIME_sequence_t([ \t]*)\*sequence;([ \t]*)\n', '\n' ), - ( 'u', '\n([ \t]*)RUNTIME_request_t([ \t]*)\*request;([ \t]*)\n', '\n' ), - ( 'u', '\n([ \t]*)if([\s\S]*?)RUNTIME_sequence_flush([^;]*);([ \t]*)\n', '\n' ), - ( 'u', 'int info;', 'int info = 0;' ), - ( 'u', 'quark_unpack_args_([\w]*)\(([\s]*)quark([\s]*),', 'starpu_codelet_unpack_args(cl_arg,' ), - ( 'u', 'starpu_codelet_unpack_args\(([^;]*),([\s]*)sequence([^)]*)', 'starpu_codelet_unpack_args(\\1\\3' ), - ( 'u', 'starpu_codelet_unpack_args\(([^;]*),([\s]*)request([^;]*)', 'starpu_codelet_unpack_args(\\1\\3' ), - ( 'r', 'starpu_codelet_unpack_args\(([^;]*),([\s]*)([^&\s]+)([^;]*);', 'starpu_codelet_unpack_args(\\1,\\2&\\3\\4;' ), - ( 'r', 'RTBLKADDR\(([ \t]*)([\w]+)([\s\S]*)CHAMELEON_Complex64_t([ \t]*)\*\\2;([\s\S]*)\n([ \t]*)starpu_codelet_unpack_args([^;]*),([\s]*)&\\2([,\\)]+)', - 'RTBLKADDR(\\1\\2\\3CHAMELEON_Complex64_t\\4*\\2;\\5\n\\6\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[0]);\n\\6starpu_codelet_unpack_args\\7\\9'), - - # repeat: We need to repeat manually to increase the index of descr - ( 'u', 'descr\[0\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[0\]', - 'descr[0]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[1]' ), - ( 'u', 'descr\[1\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[0\]', - 'descr[1]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[2]' ), - ( 'u', 'descr\[2\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[1\]', - 'descr[2]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[3]' ), - ( 'u', 'descr\[3\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[2\]', - 'descr[3]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[4]' ), - ( 'u', 'descr\[4\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[3\]', - 'descr[4]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[5]' ), - ( 'u', 'descr\[5\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[4\]', - 'descr[5]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[6]' ), - ( 'u', 'descr\[6\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[5\]', - 'descr[6]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[7]' ), - ( 'u', 'descr\[7\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[6\]', - 'descr[7]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[8]' ), - ( 'u', 'descr\[8\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[7\]', - 'descr[8]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[9]' ), - ( 'u', 'descr\[9\]\);([ \t\n]*)([\w]*) = \(CHAMELEON_Complex64_t \*\)STARPU_MATRIX_GET_PTR\(descr\[8\]', - 'descr[9]);\\1\\2 = (CHAMELEON_Complex64_t *)STARPU_MATRIX_GET_PTR(descr[9]' ), - # end repeat - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[0\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[0]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 1, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[1\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[1]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 2, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[2\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[2]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 3, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[3\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[3]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 4, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[4\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[4]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 5, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[5\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[5]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 6, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[6\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[6]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 7, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[7\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[7]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 8, cl_\\1_cpu_func)\n' ), - ( 'r', 'cl_([\w]*)_cpu_func\(([\s\S]*?)STARPU_MATRIX_GET_PTR\(descr\[8\]\);([\s]*)starpu_codelet_unpack_args([\s\S]*)$', - 'TREATED_\\1_cpu_func(\\2STARPU_MATRIX_GET_PTR(descr[8]);\\3starpu_codelet_unpack_args\\4/*\n * Codelet definition\n */\nCODELETS_CPU(\\1, 9, cl_\\1_cpu_func)\n' ), - ( 'u', 'TREATED', 'cl' ), - # end Transformation - - # Transformation for CHAMELEON_TASK - ( 'u', '\n([ \t]*)DAG_CORE_([\w]*);\n', '\n' ), - ( 'u', 'QUARK_Insert_Task', 'starpu_insert_task' ), - ( 'u', 'options->quark([\s\S]*?)options->task_flags,', 'codelet,' ), - ( 'u', 'CHAMELEON_TASK_([\w]*)\(([^)]*)\)([\s]*){([\s]*)([\w])', - 'CHAMELEON_TASK_\\1(\\2)\\3{\\4(void)nb;\\4struct starpu_codelet *codelet = &cl_\\1;\\4void (*callback)(void*) = options->profiling ? cl_\\1_callback : NULL;\\4\\5' ), - ( 'r', 'starpu_insert_task\(([^;]*)\|([\s]*)LOCALITY([^;]*?)', 'starpu_insert_task(\\1\\3' ), - ( 'r', 'starpu_insert_task\(([^;]*)\|([\s]*)QUARK_REGION_D([^;]*?)', 'starpu_insert_task(\\1\\3' ), - ( 'r', 'starpu_insert_task\(([^;]*)\|([\s]*)QUARK_REGION_U([^;]*?)', 'starpu_insert_task(\\1\\3' ), - ( 'r', 'starpu_insert_task\(([^;]*)\|([\s]*)QUARK_REGION_L([^;]*?)', 'starpu_insert_task(\\1\\3' ), - ( 'r', 'starpu_insert_task\(([^;]*)sizeof\(RUNTIME_request_t([ \t]*)\*\)([\s\S]*?),([\s\S]*?),([\s\S]*?),([ \t]*)\n([ \t]*)sizeof', - 'starpu_insert_task(\\1sizeof' ), - ( 'r', 'starpu_insert_task\(([^;]*)sizeof\(RUNTIME_sequence_t([ \t]*)\*\)([\s\S]*?),([\s\S]*?),([\s\S]*?),([ \t]*)\n([ \t]*)sizeof', - 'starpu_insert_task(\\1sizeof' ), - ( 'r', 'starpu_insert_task\(([^;]*)sizeof\(([^,]*),([\s]*)RTBLKADDR\(([^)]*)\),([\s]*)([\S]*)([\s]*),', - 'starpu_insert_task(\\1\\6,\\5RTBLKADDR(\\4),' ), - ( 'r', 'starpu_insert_task\(([^;]*)sizeof\(([^,]*),([\s]*)([\S]*)([\s]*),([\s]*)([\S]*)([\s]*),', - 'starpu_insert_task(\\1\\7,\\6\\4\\5,\\3CONV_BACKUP(\\2,' ), - - ( 'r', 'starpu_insert_task\(([^;]*)CONV_BACKUP([^;]*)', 'starpu_insert_task(\\1sizeof\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)VALUE([^;]*)', 'starpu_insert_task(\\1STVAL\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)STVAL([^;]*)', 'starpu_insert_task(\\1STARPU_VALUE\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)INOUT([^;]*)', 'starpu_insert_task(\\1STARPU_RW\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)INPUT([^;]*)', 'starpu_insert_task(\\1STARPU_R\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)OUTPUT([^;]*)', 'starpu_insert_task(\\1STARPU_W\\2' ), - ( 'r', 'starpu_insert_task\(([^;]*)SCRATCH([^;]*)', 'starpu_insert_task(\\1STARPU_TREATED\\2' ), - ( 'u', 'TREATED', 'SCRATCH' ), - ( 'u', 'starpu_insert_task\(([^;]*),([\s]*) 0\);', - 'starpu_insert_task(\\1,\\2 STARPU_PRIORITY,\toptions->priority,\\2 STARPU_CALLBACK,\tcallback,\\2 0);' ), - # end Transformation - - # Special transformation for IPIV - ( 'u', 'STARPU_([\w]*),([\s]*)IPIV,([\s]*)sizeof\(int\)([^,]*)', 'STARPU_VALUE,\\2&IPIV,\\3sizeof(int*)' ), - - # Special remove - ( 'u', 'CHAMELEON_TASK_zlaset2\(([^)]*)\)([\s]*){([\s]*)\(void\)nb;', 'CHAMELEON_TASK_zlaset2(\\1)\\2{\\3' ), - ( 'u', 'CHAMELEON_TASK_zlaset\(([^)]*)\)([\s]*){([\s]*)\(void\)nb;', 'CHAMELEON_TASK_zlaset(\\1)\\2{\\3' ), - ( 'u', 'CHAMELEON_TASK_zplghe\(([^)]*)\)([\s]*){([\s]*)\(void\)nb;', 'CHAMELEON_TASK_zplghe(\\1)\\2{\\3' ), - ( 'u', 'CHAMELEON_TASK_zplrnt\(([^)]*)\)([\s]*){([\s]*)\(void\)nb;', 'CHAMELEON_TASK_zplrnt(\\1)\\2{\\3' ), - ( 'u', 'CHAMELEON_TASK_zplgsy\(([^)]*)\)([\s]*){([\s]*)\(void\)nb;', 'CHAMELEON_TASK_zplgsy(\\1)\\2{\\3' ), - # end remove - ( 'u', '/([\s\\*\\/]*?)/', '' ), - ], - - # ------------------------------------------------------------ - # replacements applied to codelet_starpu files (workspace). - 'codelet_starpu_ws' : [ - # Suppress multiple SCRATCH - ( 'r', 'starpu_insert_task\(([^;]*)\n^([\s]*)STARPU_SCRATCH,([\s]*)NULL,([^,]*),([^;]*)^([\s]*)STARPU_SCRATCH,([\s]*)NULL,([^,]*),', - 'starpu_insert_task(\\1\\5\\6STARPU_SCRATCH,\\7NULL,\\8,' ), - ( 'u', '^([\s]*)STARPU_SCRATCH,([\s]*)NULL,([^,]*),', - '\\1STARPU_VALUE,\\2&h_work, sizeof(CHAMELEON_starpu_ws_t *),\n\\1STARPU_VALUE,\\2&d_work, sizeof(CHAMELEON_starpu_ws_t *),' ), - ( 'u', '^([ \t]*)starpu_insert_task', '\\1CHAMELEON_starpu_ws_t *h_work = (CHAMELEON_starpu_ws_t*)(options->ws_host);\n\\1CHAMELEON_starpu_ws_t *d_work = (CHAMELEON_starpu_ws_t*)(options->ws_device);\n\n\\1starpu_insert_task' ), - # Modify cl_***_cpu_func - ( 'u', 'static void cl_([\w]*)([^{]*?){', 'static void cl_\\1\\2{\n\tCHAMELEON_starpu_ws_t *h_work;\n\tCHAMELEON_starpu_ws_t *d_work;' ), - ( 'r', 'CHAMELEON_Complex64_t([\s]*)\*([\w]*);([\s\S]*?)^([\s]*)starpu_codelet_unpack_args\(([^;]*)\&\\2([,\)])([^;]*);', - 'CHAMELEON_Complex64_tDONE\\1*\\2;\\3\\4starpu_codelet_unpack_args(\\5&\\2\\6\\7;\n\\4\\2 = (CHAMELEON_Complex64_t*)RUNTIME_starpu_ws_getlocal(h_work);' ), - ( 'r', 'CHAMELEON_Complex64_tDONE([\s]*)\*([\w]*);([\s\S]*?)^([\s]*)starpu_codelet_unpack_args\(([^;]*)\&\\2([,\)])', - 'CHAMELEON_Complex64_tDONE\\1*\\2;\\3\\4starpu_codelet_unpack_args(\\5CLSCRATCH\\6' ), - ( 'r', 'starpu_codelet_unpack_args\(([^;]*)CLSCRATCH([,\)])([^;]*)CLSCRATCH([,\)])', - 'starpu_codelet_unpack_args(\\1\\3CLSCRATCH\\4' ), - ( 'u', 'starpu_codelet_unpack_args\(([^;]*)CLSCRATCH', 'starpu_codelet_unpack_args(\\1&h_work, &d_work' ), - ( 'u', 'CHAMELEON_Complex64_tDONE', 'CHAMELEON_Complex64_t' ), - # Specifc transformation - change order of WORK and TAU - ( 'u', 'WORK([^;]*)RUNTIME_starpu_ws_getlocal([^;]*);([\s]*)TAU([^;]*)RUNTIME_starpu_ws_getlocal([^;]*);', - 'TAU\\4RUNTIME_starpu_ws_getlocal\\5;\\3WORK = TAU + max( m, n );' ), - ], - - # ------------------------------------------------------------ - # replacements applied to codelet_starpu files (cuda). - 'codelet_starpu_cuda' : [ - # Transformation for cl_***_cuda_func (cublas) - ( 'u', 'static void cl_([\w]*)_cpu_func\(([^)]*)\)([\s]*){([\s\S]*?)}', - 'static void cl_\\1_cpu_func(\\2)\\3{\\4}\n\n#ifdef CHAMELEON_USE_CUDA\nstatic void cl_\\1_cuda_func(\\2)\\3{\\4}\n#endif\n' ), - ( 'u', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)return([\s]*);([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4\\6}' ), - ( 'u', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4\n\tcudaThreadSynchronize();\n\treturn;\n}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)cblas_z([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4cublasZ\\5}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)CHAMELEON_Complex64_t([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4cuDoubleComplex\\5}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)CBLAS_SADDR\(([\w]*)\)([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4\\5\\6}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)([\s]*)CblasColMajor,([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4\\6}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)\(CBLAS_([A-Z]*)\)([\w]*),([\s\S]*?)}', - 'cl_\\1_cuda_func(\\2)\\3{\\4lapack_const(\\6),\\7}' ), - # end Transformation - - # Transformation for cl_***_cuda_func (geadd) - ( 'u', 'cl_zgeadd_cuda_func\(([^)]*)\)([\s]*){([\s]*)int([\s\S]*?)}', 'cl_zgeadd_cuda_func(\\1)\\2{\\3int j;\n\tint\\4}' ), - ( 'u', 'cl_zgeadd_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)CORE_zgeadd\(M, N, alpha, A, LDA, B, LDB\);([\s\S]*?)}', - 'cl_zgeadd_cuda_func(\\1)\\2{\\3if (M == LDA && M == LDB)\n\t\tcublasZaxpy(M*N, alpha, A, 1, B, 1);\n\telse {\n\t\tfor (j = 0; j < N; j++)\n\t\t\tcublasZaxpy(M, alpha, A + j*LDA, 1, B + j*LDB, 1);\n\t}\n\\4}' ), - # end Transformation - - # Transformation for cl_***_cuda_func (magma) - ( 'u', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)int info = 0;([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4int ret;\n\tint info = 0;\\5}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)([\s]*)LAPACK_COL_MAJOR,([\s\S]*?)}', 'cl_\\1_cuda_func(\\2)\\3{\\4\\6}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)info = LAPACKE_([\w]*)_work([\s\S]*?)}', - 'cl_\\1_cuda_func(\\2)\\3{\\4ret = magma_\\5_gpu\\6}' ), - ( 'r', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)int([\s\S]*?)LAPACKE_([\w]*)_work([\s\S]*?)}', - 'cl_\\1_cuda_func(\\2)\\3{\\4int ret;\n\tint\\5ret = magma_\\6_gpu\\7}' ), - ( 'u', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)ret = magma_([^;]*)\);([\s\S]*?)}', - 'cl_\\1_cuda_func(\\2)\\3{\\4ret = magma_\\5, &info);\\6}' ), - ( 'u', 'cl_([\w]*)_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)ret = magma_([^;]*);([\s\S]*?)}', - 'cl_\\1_cuda_func(\\2)\\3{\\4ret = magma_\\5;\n\t if (ret != MAGMA_SUCCESS) {\n\t\tfprintf(stderr, "Error in MAGMA: %d\\\\n", ret);\n\t\texit(-1);\n\t}\\6}' ), - # end Transformation - - # Transformation for cl_***_cuda_func (magmablas) - ( 'u', 'cl_zlaset_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)magma_zlaset_gpu([\s\S]*?)}', 'cl_zlaset_cuda_func(\\1)\\2{\\3magmablas_zlaset\\4}' ), - # end Transformation - - # Speccific add - ( 'u', 'cl_zlauum_cuda_func\(([^)]*)\)([\s]*){([\s\S]*?)int ret;([\s\S]*?)}', 'cl_zlauum_cuda_func(\\1)\\2{\\3int ret;\n\tint info = 0;\\4}' ), - #end add - - ( 'u', 'CODELETS_CPU\(([\w]*), ([\w]*), cl_([\w]*)_cpu_func\)', 'CODELETS(\\1, \\2, cl_\\3_cpu_func, cl_\\3_cuda_func)' ), - ], - - # ------------------------------------------------------------ - # replacements applied to codelet_starpu files (opencl). - 'codelet_starpu_opencl' : [ - # Transformation for cl_***_opencl_func - # end Transformation - ], - # ------------------------------------------------------------ - # replacements applied to specific headers - 'include_coreblas' : [ - ( 'u', 'void([ \t]*)QUARK_CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'int([ \t]*)QUARK_CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'void([ \t]*)CORE_([\w]*)_quark([^;]*);([^\n]*)\n', '' ), - ( 'u', '/([^/]*)called by PLASMA([^/]*)/\n', '' ), - ( 'u', '/([^/]*)called by QUARK([^/]*)/\n', '' ), - ( 'u', '#ifdef COMPLEX([ \t]*)\n#endif([ \t]*)\n', '' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'PLASMA_Complex64_t', 'CHAMELEON_Complex64_t' ), - ( 'u', 'PLASMA_Complex32_t', 'CHAMELEON_Complex32_t' ), - ( 'u', 'PLASMA_enum', 'CHAMELEON_enum' ), - ( 'u', 'PLASMA_CORE', 'CHAMELEON_CORE' ), - ], - # - # - 'include_runtime' : [ - ( 'u', 'core_zblas.h', 'runtime_z.h' ), - ( 'u', 'core_zcblas.h', 'runtime_zc.h' ), - ( 'u', '_PLASMA_CORE_', '_RUNTIME_' ), - ( 'u', 'void([ \t]*)CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'int([ \t]*)CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', '#ifdef COMPLEX([ \t]*)\n#endif([ \t]*)\n', '' ), - ( 'u', '/([^/]*)serial kernels([^/]*)/\n', '' ), - ( 'u', '/([^/]*)called by QUARK([^/]*)/\n', '' ), - - ( 'u', 'Quark([\s]*)\*quark,([\s]*)Quark_Task_Flags([\s]*)\*task_flags,', 'RUNTIME_option_t *options,' ), - ( 'u', 'PLASMA_sequence([^,]*)sequence\)', ')' ), - ( 'u', 'PLASMA_request([^,]*)request\)', ')' ), - ( 'u', 'PLASMA_sequence([^,]*)sequence,', '' ), - ( 'u', 'PLASMA_request([^,]*)request,', '' ), - ( 'u', 'void([ \t]*)QUARK_CORE_([^)]*),([\s]*)\);', 'void\\1QUARK_CORE_\\2);' ), - ( 'u', 'int([ \t]*)QUARK_CORE_([^)]*),([\s]*)\);', 'int\\1QUARK_CORE_\\2);' ), - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)const ([ \t\w]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2\\3*\\4,' ), - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)PLASMA_Complex64_t([ \t]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2CHAM_desc_t *\\4, int \\4m, int \\4n,' ), - ( 'r', 'QUARK_CORE([\w]*)\(([\s\S]*)PLASMA_Complex32_t([ \t]*)\*([\w]*),' , 'QUARK_CORE\\1(\\2CHAM_desc_t *\\4, int \\4m, int \\4n,' ), - - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - - ( 'u', 'QUARK_CORE', 'CHAMELEON_TASK' ), - ( 'u', 'PLASMA', 'CHAMELEON' ), - ], - # - # - 'include_quarkblas' : [ - ( 'u', 'core_zblas.h', 'quark_zblas.h' ), - ( 'u', 'core_zcblas.h', 'quark_zcblas.h' ), - ( 'u', '_PLASMA_CORE_', '_QUARK_' ), - ( 'u', 'void([ \t]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'int([ \t]*)CORE_([a-zA-Z0-9]*)\(([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'void([ \t]*)CORE_([\w]*)_(^q])([a-zA-Z0-9]*)\(([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'int([ \t]*)CORE_([\w]*)_([^q])([a-zA-Z0-9]*)\(([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'void([ \t]*)QUARK_CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', 'int([ \t]*)QUARK_CORE_([^)]*)\);([^\n]*)\n', '' ), - ( 'u', '/([^/]*)called by PLASMA([^/]*)/\n', '' ), - ( 'u', '/([^/]*) serial kernels([^/]*)/\n', '' ), - ( 'u', '#ifdef COMPLEX([ \t]*)\n#endif([ \t]*)\n', '' ), - - ( 'u', 'PLASMA', 'CHAMELEON' ), - ], - # - # - 'include_morse' : [ - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'plasma', 'morse' ), - ], - - # ------------------------------------------------------------ - # replacements applied to control files. - 'control' : [ - ( 'u', 'plasma_alloc_ipiv\(([\w]*), ([\w]*), PLASMA_FUNC_ZGESV, \(void([ ]*)\*\*\)IPIV\)', - 'chameleon_alloc_ipiv(\\1, \\2, CHAMELEON_FUNC_ZGESV, ChamComplexDouble, descL, (void**)IPIV)' ), - ( 'u', 'plasma_shared_alloc', 'chameleon_desc_mat_alloc' ), - ( 'u', 'Declarations of parallel functions \(static scheduling\)([\s\S]*?)Declarations of internal sequential functions', - 'Declarations of internal sequential functions' ), - ( 'u', 'plasma_parallel_call_([\w]*)\(([\s\\\]*)plasma_([\w]*),([^;]*);', 'chameleon_\\3(\\4;' ), - ( 'u', 'chameleon_pzlapack_to_tile\(([^;]*?);', 'chameleon_pzlapack_to_tile(A, lm, &descA, seq, req);' ), - ( 'u', 'chameleon_pztile_to_lapack\(([^;]*?);', 'chameleon_pztile_to_lapack(&descA, A, lm, seq, req);' ), - ( 'u', 'PLASMA_Dealloc_Handle_Tile', 'CHAMELEON_Dealloc_Workspace' ), - - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - ( 'u', 'PLASMA_desc([ \t]*)([\w])', 'CHAM_desc_t\\1*\\2' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'plasma_context_t', 'CHAM_context_t' ), - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - ( 'u', '_quark', '' ), - - # Add chameleon_zdesc_alloc in compute_z.h - ( 'u', '#define chameleon_zdesc_alloc', - '#define chameleon_zdesc_alloc2(descA, mb, nb, lm, ln, i, j, m, n) \\\n\tdescA = chameleon_desc_init( \\\n\t\tChamComplexDouble, (mb), (nb), ((mb)*(nb)), \\\n\t\t(m), (n), (i), (j), (m), (n)); \\\n\tchameleon_desc_mat_alloc( &(descA) );\n\n#define chameleon_zdesc_alloc' ), - # end add - ], - - # ------------------------------------------------------------ - # replacements applied to timing files. - 'timing' : [ - ( 'u', 'PLASMA_Dealloc_Handle_Tile', 'CHAMELEON_Dealloc_Workspace' ), - ( 'u', 'PLASMA_sequence', 'RUNTIME_sequence_t' ), - ( 'u', 'PLASMA_request', 'RUNTIME_request_t' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'real_Double_t', 'chameleon_time_t' ), - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - - # Add dirty getoncpu( descA ), will need to handle that within the sequence for exemple - ( 'u', '(CHAMELEON_Sequence_Wait\([^;]*\);\n)([\s]*)STOP_TIMING', '\\1\\2CHAMELEON_Desc_getoncpu( descA );\n\\2STOP_TIMING' ), - ], - - # ------------------------------------------------------------ - # replacements applied to timing files. - 'testing' : [ - ( 'u', 'core_blas.h', 'coreblas.h' ), - ( 'u', 'testing_zmain.h', 'testing_zauxiliary.h' ), - ( 'u', 'real_Double_t', 'chameleon_time_t' ), - ( 'u', 'int([\s]*)testing_([^{]*){', 'int\\1testing_\\2{\n\tint hres = 0;' ), - ( 'u', 'int([\s]*)testing_([\s\S]*?)return 0;', 'int\\1testing_\\2return hres;' ), - ( 'u', 'int([\s]*)testing_([\s\S]*?)FAILED([^;]*?);', 'int\\1testing_\\2FAILED\\3;\thres++;' ), - ( 'u', 'PLASMA_desc', 'CHAM_desc_t' ), - ( 'u', 'PLASMA_Finalize', 'CHAMELEON_Finalize' ), - ( 'u', 'PLASMA_Dealloc_Handle_Tile', 'CHAMELEON_Dealloc_Workspace' ), - - ( 'u', 'PLASMA', 'CHAMELEON' ), - ( 'u', 'Plasma', 'Cham' ), - ( 'u', 'plasma', 'morse' ), - - # Specific fix for testing_zgesv_incpiv (will be fix in plasma) - ( 'u', 'int testing_zgesv_incpiv\(([\s\S]*)CHAMELEON_Complex64_t \*L;', 'int testing_zgesv_incpiv(\\1CHAM_desc_t *L;' ), - ], - - # -------------------------------------------------------- - # replacements applied to ALL at the end. - 'all_end' : [ - ( 'u', 'provided by Univ. of Tennessee,', 'provided by Inria Bordeaux - Sud-Ouest, LaBRI,' ), - ( 'u', 'Univ. of California Berkeley and Univ. of Colorado Denver', 'University of Bordeaux, Bordeaux INP' ), - ( 'u', '@version 2.6.0\n \* @author', - '@version 2.6.0\n * @comment This file has been automatically generated\n * from Plasma 2.6.0 for CHAMELEON 0.9.2\n * @author' ), - ( 'u', '/([\*]+)/\n/([\*]+)/', '' ), - ( 'u', '/([\*]+)/\n/', '\n/' ), - ( 'u', '/([\*]+)/([a-zA-Z]+)', '\\2' ), - ], -}; - -adds = { - # -------------------------------------------------------- - # replacements applied to ALL files. - 'all' : [ - ( 'u', None , None ), - ], -}; diff --git a/runtime/CMakeLists.txt b/runtime/CMakeLists.txt index 879d3cee22e8efa6d7cb3d17b4f8a31a3e85adad..71724813e89887a857b5d54aa5f8c82146097361 100644 --- a/runtime/CMakeLists.txt +++ b/runtime/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,11 +17,11 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @date 2020-03-03 # ### diff --git a/runtime/openmp/CMakeLists.txt b/runtime/openmp/CMakeLists.txt index e792c8f22ee397699eefd9e316a2f392e96b62c0..fba0c9b16c939d369d3cf535923c053dd917efdb 100644 --- a/runtime/openmp/CMakeLists.txt +++ b/runtime/openmp/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2015 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2018-06-15 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 2.8) diff --git a/runtime/openmp/codelets/codelet_dzasum.c b/runtime/openmp/codelets/codelet_dzasum.c index e5d37a1b9dbc7ddbe7efe562898dd8d18bbd8459..5e9146277a7cfc6ab2d8e3c88f003d2e69f0727a 100644 --- a/runtime/openmp/codelets/codelet_dzasum.c +++ b/runtime/openmp/codelets/codelet_dzasum.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_dzasum.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon dzasum OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_map.c b/runtime/openmp/codelets/codelet_map.c index 9bceac18976cfa0d5a841343bbbf79f08029e963..c5fca54e60a219abe065f633b3ca8a3b496f7f8c 100644 --- a/runtime/openmp/codelets/codelet_map.c +++ b/runtime/openmp/codelets/codelet_map.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_map.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * */ #include "chameleon_openmp.h" diff --git a/runtime/openmp/codelets/codelet_zaxpy.c b/runtime/openmp/codelets/codelet_zaxpy.c index 1c0006d8217b28e22d02938760ce8914a59eba45..6e57ef72c15c22324a1c68af9807f5db0d53b0c2 100644 --- a/runtime/openmp/codelets/codelet_zaxpy.c +++ b/runtime/openmp/codelets/codelet_zaxpy.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zaxpy.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zaxpy OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zbuild.c b/runtime/openmp/codelets/codelet_zbuild.c index 98170904d04e9b92320afa0b3ff72206bc7ac638..9e8f493ee9f132cd21144fd8e1214321e26f7873 100644 --- a/runtime/openmp/codelets/codelet_zbuild.c +++ b/runtime/openmp/codelets/codelet_zbuild.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zbuild.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zbuild OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgeadd.c b/runtime/openmp/codelets/codelet_zgeadd.c index 60e8af6fb3adff9d698ac6eac0dbbf2c30038e42..f1a287b29688f59ff261f541e0d67cbd7d301d92 100644 --- a/runtime/openmp/codelets/codelet_zgeadd.c +++ b/runtime/openmp/codelets/codelet_zgeadd.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgeadd.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgelqt.c b/runtime/openmp/codelets/codelet_zgelqt.c index b6004abfa9d69c7cbf3d6347190b64a728cb086b..40147bebf59ee62d4154365644ce4ff0175dfdbc 100644 --- a/runtime/openmp/codelets/codelet_zgelqt.c +++ b/runtime/openmp/codelets/codelet_zgelqt.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgelqt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgemm.c b/runtime/openmp/codelets/codelet_zgemm.c index a65f303de24611773203f89384b95c313969036e..152d1a9ea9518586508c96be363def9232ee80c4 100644 --- a/runtime/openmp/codelets/codelet_zgemm.c +++ b/runtime/openmp/codelets/codelet_zgemm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgemm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgeqrt.c b/runtime/openmp/codelets/codelet_zgeqrt.c index 1fdaa8683ae09e90e4495fe5f76de9e4c34b8934..82bcaf7c5861dfce72af66df443e0fb00a40eb70 100644 --- a/runtime/openmp/codelets/codelet_zgeqrt.c +++ b/runtime/openmp/codelets/codelet_zgeqrt.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgeqrt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgessm.c b/runtime/openmp/codelets/codelet_zgessm.c index c9bfcd2f33c7cc40ca07793c61b6dcf7a1db2bc5..e9a1f065605eede3ba42afbbb791209dfdc1ca6e 100644 --- a/runtime/openmp/codelets/codelet_zgessm.c +++ b/runtime/openmp/codelets/codelet_zgessm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgessm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgessq.c b/runtime/openmp/codelets/codelet_zgessq.c index ccf2ee3435b318a0dd1f48e011366bf3717b71a2..ce787c672df1a54bf84c8302bff88b1970a3e3dc 100644 --- a/runtime/openmp/codelets/codelet_zgessq.c +++ b/runtime/openmp/codelets/codelet_zgessq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgessq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgetrf.c b/runtime/openmp/codelets/codelet_zgetrf.c index 4ed49a30cca24c06036fd58707cd37c1a3b7b1f9..0081d61511ccd10bf856a0c81e54ccab808ca0ca 100644 --- a/runtime/openmp/codelets/codelet_zgetrf.c +++ b/runtime/openmp/codelets/codelet_zgetrf.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgetrf.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgetrf_incpiv.c b/runtime/openmp/codelets/codelet_zgetrf_incpiv.c index 8dcf085390cafcff2f644a75c30f17268b662223..ac484f46c65d227c06970ac596adcb3687e44aae 100644 --- a/runtime/openmp/codelets/codelet_zgetrf_incpiv.c +++ b/runtime/openmp/codelets/codelet_zgetrf_incpiv.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgetrf_incpiv.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_incpiv OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgetrf_nopiv.c b/runtime/openmp/codelets/codelet_zgetrf_nopiv.c index 53446efac813836c5c954046ceea02e9ab2356f0..c50f1de1f1db228713c22fda0328c7b2389e106b 100644 --- a/runtime/openmp/codelets/codelet_zgetrf_nopiv.c +++ b/runtime/openmp/codelets/codelet_zgetrf_nopiv.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgetrf_nopiv.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zgram.c b/runtime/openmp/codelets/codelet_zgram.c index af0363df7a1818789390d1e70f9bc477656e892e..3c850e758fc0cec5809f6c86f8b2a6ad61a91760 100644 --- a/runtime/openmp/codelets/codelet_zgram.c +++ b/runtime/openmp/codelets/codelet_zgram.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> s d c z * */ diff --git a/runtime/openmp/codelets/codelet_zhe2ge.c b/runtime/openmp/codelets/codelet_zhe2ge.c index df85d582d252ce765e80271e94e22c1609b32e74..4904fe32ab0618eccf8b707dd8bb1e2904b35b3e 100644 --- a/runtime/openmp/codelets/codelet_zhe2ge.c +++ b/runtime/openmp/codelets/codelet_zhe2ge.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zhe2ge.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhe2ge OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zhemm.c b/runtime/openmp/codelets/codelet_zhemm.c index f472ceac36ef7eae036940e4813a6a09de184660..8f044af28f736a991de0333041979ab0583aa3a8 100644 --- a/runtime/openmp/codelets/codelet_zhemm.c +++ b/runtime/openmp/codelets/codelet_zhemm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zhemm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zher2k.c b/runtime/openmp/codelets/codelet_zher2k.c index 1c67a996ce1a34ca9610ff465792cf4a963c847e..deefdfbbb41396d7752184ee28994e982f9afbb3 100644 --- a/runtime/openmp/codelets/codelet_zher2k.c +++ b/runtime/openmp/codelets/codelet_zher2k.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zher2k.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zherfb.c b/runtime/openmp/codelets/codelet_zherfb.c index 6dfa2fe3a15b38dca26c1a3b19e81a26c900b5ec..f05807ef882c0d28a7301ce54f8576f9f24df3cd 100644 --- a/runtime/openmp/codelets/codelet_zherfb.c +++ b/runtime/openmp/codelets/codelet_zherfb.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zherfb.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherfb OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zherk.c b/runtime/openmp/codelets/codelet_zherk.c index d05ef433174d13f65951e9ab971108a2e5f2d833..138e306f93e87e5d0f6b6c717354f0aaf7816936 100644 --- a/runtime/openmp/codelets/codelet_zherk.c +++ b/runtime/openmp/codelets/codelet_zherk.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zherk.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zhessq.c b/runtime/openmp/codelets/codelet_zhessq.c index 7f1c8ae11bb226749794a67176955accafe899de..7c2468700444126bc5e6f6827d705fed1990b2b6 100644 --- a/runtime/openmp/codelets/codelet_zhessq.c +++ b/runtime/openmp/codelets/codelet_zhessq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zhessq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhessq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zlacpy.c b/runtime/openmp/codelets/codelet_zlacpy.c index a2bdc0947ceb984e3e12b7987a23c442931ec568..fc36a10fce9554774d5d067fac6c0617a6c71887 100644 --- a/runtime/openmp/codelets/codelet_zlacpy.c +++ b/runtime/openmp/codelets/codelet_zlacpy.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlacpy.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlag2c.c b/runtime/openmp/codelets/codelet_zlag2c.c index 1edde747d708f3102289bae61c77b46bc84c6408..efff2e330627d6265695ca801be946a77937fbc3 100644 --- a/runtime/openmp/codelets/codelet_zlag2c.c +++ b/runtime/openmp/codelets/codelet_zlag2c.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlag2c.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlag2c OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/runtime/openmp/codelets/codelet_zlange.c b/runtime/openmp/codelets/codelet_zlange.c index b9ec27f1052e8e37d56762de1491e1b4d8fe4ae0..89a3f947a5c1331c7687dfa1860d731f86d8b28b 100644 --- a/runtime/openmp/codelets/codelet_zlange.c +++ b/runtime/openmp/codelets/codelet_zlange.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlange.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlanhe.c b/runtime/openmp/codelets/codelet_zlanhe.c index 9b13a208ffb89d38ce148902acd7e41f9916952b..79c729195385a62a396770eb78b10629af981790 100644 --- a/runtime/openmp/codelets/codelet_zlanhe.c +++ b/runtime/openmp/codelets/codelet_zlanhe.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlanhe.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zlansy.c b/runtime/openmp/codelets/codelet_zlansy.c index 9046ca44c76753e1cb8320db039697f805ca2574..c52d16f51dc386c4726a7b1a865922600e32a95a 100644 --- a/runtime/openmp/codelets/codelet_zlansy.c +++ b/runtime/openmp/codelets/codelet_zlansy.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlansy.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlantr.c b/runtime/openmp/codelets/codelet_zlantr.c index 0006b23035387bdace48a1446400e1c8b65e8f8c..b9d651b7c1260f1aa94ed3e8196dbe6210bf13bc 100644 --- a/runtime/openmp/codelets/codelet_zlantr.c +++ b/runtime/openmp/codelets/codelet_zlantr.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlantr.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlascal.c b/runtime/openmp/codelets/codelet_zlascal.c index 71bb938c73a38df3063793c7df70ae7b5ee96cf7..fdce7f43b305313843cd7838eb689c5658812003 100644 --- a/runtime/openmp/codelets/codelet_zlascal.c +++ b/runtime/openmp/codelets/codelet_zlascal.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlascal.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlaset.c b/runtime/openmp/codelets/codelet_zlaset.c index 5e083ffb12d5db6a9fc9a2f602a4f58a86027ad2..f38682f3e05addaa33293d22bf7d55e33e259963 100644 --- a/runtime/openmp/codelets/codelet_zlaset.c +++ b/runtime/openmp/codelets/codelet_zlaset.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlaset.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlaset2.c b/runtime/openmp/codelets/codelet_zlaset2.c index 0203e4b79b73d2e2a0e53a7cc8f5c43bb33bb15c..e648e6e0a422b1d0bac926c26913f4e55ec44fe6 100644 --- a/runtime/openmp/codelets/codelet_zlaset2.c +++ b/runtime/openmp/codelets/codelet_zlaset2.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlaset2.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset2 OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlatro.c b/runtime/openmp/codelets/codelet_zlatro.c index 408a5a7fdec6072d0a747d707fdc56f3d97e77be..f09c49f401c2731811ba62bfda93d2900ef8f192 100644 --- a/runtime/openmp/codelets/codelet_zlatro.c +++ b/runtime/openmp/codelets/codelet_zlatro.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlatro.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlatro OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zlauum.c b/runtime/openmp/codelets/codelet_zlauum.c index 48f1704d1024f4ae1b7b3114931639c7cbd8eb47..b6a7a346cd5c1ff6b5921f6cd5775535bed960e9 100644 --- a/runtime/openmp/codelets/codelet_zlauum.c +++ b/runtime/openmp/codelets/codelet_zlauum.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zlauum.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zplghe.c b/runtime/openmp/codelets/codelet_zplghe.c index 148360e139f4e4a41fb34e01324ebf6aa23445e4..27f57ca964e89ba7ece3832f4a968c95d8cf0737 100644 --- a/runtime/openmp/codelets/codelet_zplghe.c +++ b/runtime/openmp/codelets/codelet_zplghe.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zplghe.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_zplgsy.c b/runtime/openmp/codelets/codelet_zplgsy.c index f33f432205e1d2a8122eb62c9302163859049379..2f7b4135bc6925d3eb8460caa51e7c4dffe32294 100644 --- a/runtime/openmp/codelets/codelet_zplgsy.c +++ b/runtime/openmp/codelets/codelet_zplgsy.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zplgsy.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zplrnt.c b/runtime/openmp/codelets/codelet_zplrnt.c index 4251214c6143fed6b62ac4f9cf3c3bc49d5268e2..513ce2c6fba12c543c0f77bd038fcd47d6f94b23 100644 --- a/runtime/openmp/codelets/codelet_zplrnt.c +++ b/runtime/openmp/codelets/codelet_zplrnt.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zplrnt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zplssq.c b/runtime/openmp/codelets/codelet_zplssq.c index 260a1f29bde9bb3a68d5b8976b2d9a4fe8c6210f..42850ccbdeac1d0938f80e4c530f577c963ee05c 100644 --- a/runtime/openmp/codelets/codelet_zplssq.c +++ b/runtime/openmp/codelets/codelet_zplssq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zplssq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplssq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zpotrf.c b/runtime/openmp/codelets/codelet_zpotrf.c index aea59eab66db7d93f2719682936a730bb5a11505..546e29f377c11c84c38f94397da22ee30d9679ef 100644 --- a/runtime/openmp/codelets/codelet_zpotrf.c +++ b/runtime/openmp/codelets/codelet_zpotrf.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zpotrf.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zssssm.c b/runtime/openmp/codelets/codelet_zssssm.c index a0e23614ed8dd39373d40e8c1540d22ab60d69ee..ff79d04ab3af432d0365943d6c1969eaa091a8d3 100644 --- a/runtime/openmp/codelets/codelet_zssssm.c +++ b/runtime/openmp/codelets/codelet_zssssm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zssssm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zssssm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zsymm.c b/runtime/openmp/codelets/codelet_zsymm.c index 60bbbfbd1914f5e1212c8765778f0c9bd7498c50..dc733162c98bd384b2ab754d3acf3ecb8bf25d0a 100644 --- a/runtime/openmp/codelets/codelet_zsymm.c +++ b/runtime/openmp/codelets/codelet_zsymm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zsymm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zsyr2k.c b/runtime/openmp/codelets/codelet_zsyr2k.c index 73d09b143ba46b8bd15ab7d1ebf2e145821bc628..557aeaedffaadc088c0bf1bb746184e376c7ef48 100644 --- a/runtime/openmp/codelets/codelet_zsyr2k.c +++ b/runtime/openmp/codelets/codelet_zsyr2k.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zsyr2k.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zsyrk.c b/runtime/openmp/codelets/codelet_zsyrk.c index 89d674a7fea68c4ad994fedc9348947e75e86d62..2f8e115e1671987d66d854766d28d2ec0de1ff4a 100644 --- a/runtime/openmp/codelets/codelet_zsyrk.c +++ b/runtime/openmp/codelets/codelet_zsyrk.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zsyrk.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zsyssq.c b/runtime/openmp/codelets/codelet_zsyssq.c index e767eba613cd5394594b997ac295598e698b2831..1fb1e871104a377dcc21075a4d27e60a5066784e 100644 --- a/runtime/openmp/codelets/codelet_zsyssq.c +++ b/runtime/openmp/codelets/codelet_zsyssq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zsyssq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyssq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zsytrf_nopiv.c b/runtime/openmp/codelets/codelet_zsytrf_nopiv.c index 9f6debd57eb47570118cc317678aabbcad913f10..a378b87fc96e4582def035131a05f192eba77639 100644 --- a/runtime/openmp/codelets/codelet_zsytrf_nopiv.c +++ b/runtime/openmp/codelets/codelet_zsytrf_nopiv.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zsytrf_nopiv.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf_nopiv OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/openmp/codelets/codelet_ztplqt.c b/runtime/openmp/codelets/codelet_ztplqt.c index db708143e4c1d195074b1d753634179460790222..cdaf69955c28b622989c548b4242db5441e24524 100644 --- a/runtime/openmp/codelets/codelet_ztplqt.c +++ b/runtime/openmp/codelets/codelet_ztplqt.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztplqt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztplqt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/openmp/codelets/codelet_ztpmlqt.c b/runtime/openmp/codelets/codelet_ztpmlqt.c index 06fbb30a4a3e5a5dcf7355b9b56d3fdfd52f4473..f33e0f84f3750359501d1744e5267f354a672653 100644 --- a/runtime/openmp/codelets/codelet_ztpmlqt.c +++ b/runtime/openmp/codelets/codelet_ztpmlqt.c @@ -2,15 +2,15 @@ * * @file openmp/codelet_ztpmlqt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon ztpmlqt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/openmp/codelets/codelet_ztpmqrt.c b/runtime/openmp/codelets/codelet_ztpmqrt.c index 33a746216cc69c397110cbeac30b2c9181706473..7b4b64d809df4ad39097480025f7172d8708f01a 100644 --- a/runtime/openmp/codelets/codelet_ztpmqrt.c +++ b/runtime/openmp/codelets/codelet_ztpmqrt.c @@ -2,15 +2,15 @@ * * @file openmp/codelet_ztpmqrt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon ztpmqrt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/openmp/codelets/codelet_ztpqrt.c b/runtime/openmp/codelets/codelet_ztpqrt.c index bba9bfea39ba2d2c973521cec1c1edb21f164dde..418ccde7fd1ca879768d391072a427d085f49c41 100644 --- a/runtime/openmp/codelets/codelet_ztpqrt.c +++ b/runtime/openmp/codelets/codelet_ztpqrt.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztpqrt.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpqrt OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/openmp/codelets/codelet_ztradd.c b/runtime/openmp/codelets/codelet_ztradd.c index 18dc9cc2ade2e47b9d25ffdac95f7d12bfad2e75..cce00e32eed37951ace90e2e3af14b1ad20df367 100644 --- a/runtime/openmp/codelets/codelet_ztradd.c +++ b/runtime/openmp/codelets/codelet_ztradd.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztradd.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztrasm.c b/runtime/openmp/codelets/codelet_ztrasm.c index d3392d90e716835424c32b2d46ae9e3deca6e6b3..d99be2a1a458b32a3e12d175498b02d4ea1bb7d1 100644 --- a/runtime/openmp/codelets/codelet_ztrasm.c +++ b/runtime/openmp/codelets/codelet_ztrasm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztrasm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrasm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztrmm.c b/runtime/openmp/codelets/codelet_ztrmm.c index c7a329359ff607417812294a2420305f09948c6c..6c44888f35f99c0831c6c2c2758be89e1489541e 100644 --- a/runtime/openmp/codelets/codelet_ztrmm.c +++ b/runtime/openmp/codelets/codelet_ztrmm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztrmm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztrsm.c b/runtime/openmp/codelets/codelet_ztrsm.c index bc02e562a42124bc515ab7f005e6bf76f6d1c7dd..58f77d6f7af0db716e0c0116f99b6579b9c4d369 100644 --- a/runtime/openmp/codelets/codelet_ztrsm.c +++ b/runtime/openmp/codelets/codelet_ztrsm.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztrsm.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztrssq.c b/runtime/openmp/codelets/codelet_ztrssq.c index de53dfe7cc55cfce797c217b628ad2b8d6109c7f..28ff929def55fbb4d4e4c8235ecee5bd0ee72ace 100644 --- a/runtime/openmp/codelets/codelet_ztrssq.c +++ b/runtime/openmp/codelets/codelet_ztrssq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztrssq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrssq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztrtri.c b/runtime/openmp/codelets/codelet_ztrtri.c index 8c0d9b8b60e38f1c1a78055b8ab4457a66d9ceb8..a6487329e0e2c4ccf2c2fc1cbf4ceafe8d4e6321 100644 --- a/runtime/openmp/codelets/codelet_ztrtri.c +++ b/runtime/openmp/codelets/codelet_ztrtri.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztrtri.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztsmlq_hetra1.c b/runtime/openmp/codelets/codelet_ztsmlq_hetra1.c index 4c5ed64a58ca44edf3c6594c6a654b40dcde8ade..fa63011f4a9c6222ec8485669aa1c43f91e32b00 100644 --- a/runtime/openmp/codelets/codelet_ztsmlq_hetra1.c +++ b/runtime/openmp/codelets/codelet_ztsmlq_hetra1.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztsmlq_hetra1.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmlq_hetra1 OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztsmqr_hetra1.c b/runtime/openmp/codelets/codelet_ztsmqr_hetra1.c index 97f84c5ad13ccc1ef9f2f724c5420eb225e58838..1eb5a760d62df3d3c4a548acec9b4d66e9791ee3 100644 --- a/runtime/openmp/codelets/codelet_ztsmqr_hetra1.c +++ b/runtime/openmp/codelets/codelet_ztsmqr_hetra1.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztsmqr_hetra1.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmqr_hetra1 OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_ztstrf.c b/runtime/openmp/codelets/codelet_ztstrf.c index da5e42a9c7f57b8454b5230e40be2fb0e26d26c2..f9d4c3f7bf4bb3d6b605ee856ed021c3226abae6 100644 --- a/runtime/openmp/codelets/codelet_ztstrf.c +++ b/runtime/openmp/codelets/codelet_ztstrf.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_ztstrf.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztstrf OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zunmlq.c b/runtime/openmp/codelets/codelet_zunmlq.c index 9b62b78f49e8c8386e391b8c8853db683c05b043..86a24ca3a36049f5a14bf548580122ef666f4bf5 100644 --- a/runtime/openmp/codelets/codelet_zunmlq.c +++ b/runtime/openmp/codelets/codelet_zunmlq.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zunmlq.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/codelets/codelet_zunmqr.c b/runtime/openmp/codelets/codelet_zunmqr.c index e8af9ea663eab1febd3a250080fb9305cdda1afb..eae1cffdabe1d35402fffb2407c311b2ebde05e7 100644 --- a/runtime/openmp/codelets/codelet_zunmqr.c +++ b/runtime/openmp/codelets/codelet_zunmqr.c @@ -2,17 +2,17 @@ * * @file openmp/codelet_zunmqr.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr OpenMP codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau * @author Mathieu Faverge - * @date 2019-11-19 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/openmp/control/runtime_async.c b/runtime/openmp/control/runtime_async.c index 7de751289c7a7f95de6d56869844f87b6c09dbae..7032ec2a966478a351121cc42219bb5b29df163b 100644 --- a/runtime/openmp/control/runtime_async.c +++ b/runtime/openmp/control/runtime_async.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU asynchronous routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/openmp/control/runtime_context.c b/runtime/openmp/control/runtime_context.c index c8130f46a88eb3f4ed40137a565ae61947228d46..9e4e5c87a0c45df9112e0135d6109346e8a139af 100644 --- a/runtime/openmp/control/runtime_context.c +++ b/runtime/openmp/control/runtime_context.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU context routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/openmp/control/runtime_control.c b/runtime/openmp/control/runtime_control.c index 0f304bb38b98e35946cd99a2a9ba7b20380db336..d07758f47d7eb1d8a34d8b4305f424ebd19f1260 100644 --- a/runtime/openmp/control/runtime_control.c +++ b/runtime/openmp/control/runtime_control.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU control routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/openmp/control/runtime_descriptor.c b/runtime/openmp/control/runtime_descriptor.c index 222128c7e4816b3c10e61174fbf096ac41e195ee..e51c8a96acad22f13f158fda8845a23025c3074d 100644 --- a/runtime/openmp/control/runtime_descriptor.c +++ b/runtime/openmp/control/runtime_descriptor.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon OpenMP descriptor routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede * @author Philippe Virouleau - * @date 2018-06-15 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/openmp/control/runtime_options.c b/runtime/openmp/control/runtime_options.c index d7bd49d20e5aad1ca9d011fc3d6629be77ba668f..788c057ee31d0794a6676c769ee3b2f9b2eecb04 100644 --- a/runtime/openmp/control/runtime_options.c +++ b/runtime/openmp/control/runtime_options.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU options routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/openmp/control/runtime_profiling.c b/runtime/openmp/control/runtime_profiling.c index b243c9d4d4a13e7ce91f85c4df4600302d3eef76..dc41a473a494b2f0243f3f2bcd6cea3c9f0c1943 100644 --- a/runtime/openmp/control/runtime_profiling.c +++ b/runtime/openmp/control/runtime_profiling.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU profiling routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2018-06-15 + * @date 2020-03-03 * */ #include "chameleon_openmp.h" diff --git a/runtime/openmp/include/chameleon_openmp.h b/runtime/openmp/include/chameleon_openmp.h index c8bbbe4efd69088aeaf411853e22791b32afd30a..66126e1247f4f3b6be1d70bac5c70b84ee9cd5bf 100644 --- a/runtime/openmp/include/chameleon_openmp.h +++ b/runtime/openmp/include/chameleon_openmp.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon OpenMP runtime main header * - * @version 0.9.2 + * @version 1.0.0 * @author Philippe Virouleau - * @date 2018-06-15 + * @date 2020-03-03 * */ #ifndef _chameleon_openmp_h_ diff --git a/runtime/parsec/CMakeLists.txt b/runtime/parsec/CMakeLists.txt index 30787450afdfe5bbfa390ba2ea233788dadd4223..7ff91b30dbe28e7824072a328f3fa18e7c8653f6 100644 --- a/runtime/parsec/CMakeLists.txt +++ b/runtime/parsec/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2015 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2015-11-04 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 2.8) diff --git a/runtime/parsec/codelets/codelet_dzasum.c b/runtime/parsec/codelets/codelet_dzasum.c index 7f256d1117ea4906a478f1fe45d60ccbc91e7000..b63e9c08053686de62babc05d559da8cf76fb868 100644 --- a/runtime/parsec/codelets/codelet_dzasum.c +++ b/runtime/parsec/codelets/codelet_dzasum.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon dzasum PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_map.c b/runtime/parsec/codelets/codelet_map.c index a1a1213d56db473444449b5e64d6a55ffcd0038c..c832c230f2cae1c1bbec58469809caa08f507568 100644 --- a/runtime/parsec/codelets/codelet_map.c +++ b/runtime/parsec/codelets/codelet_map.c @@ -2,16 +2,16 @@ * * @file parsec/codelet_map.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-09-25 + * @date 2020-03-03 * */ #include "chameleon_parsec.h" diff --git a/runtime/parsec/codelets/codelet_zaxpy.c b/runtime/parsec/codelets/codelet_zaxpy.c index ed886e868ee8e081739bf0731846f61c683a1db6..c9497ddb4ec7079081149c4d5f94e523568d7abb 100644 --- a/runtime/parsec/codelets/codelet_zaxpy.c +++ b/runtime/parsec/codelets/codelet_zaxpy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zaxpy PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zbuild.c b/runtime/parsec/codelets/codelet_zbuild.c index 6118017b2abb0ae9e9c9db4cd3e8f45d462fb31c..d1e03aa9334c866e9defe1f166aaceef3b8f1a9a 100644 --- a/runtime/parsec/codelets/codelet_zbuild.c +++ b/runtime/parsec/codelets/codelet_zbuild.c @@ -4,17 +4,17 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zbuild PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Guillaume Sylvand - * @date 2016-09-08 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgeadd.c b/runtime/parsec/codelets/codelet_zgeadd.c index e1246e8af8d8bbbbb0e3a37699fba181217e09aa..3032c649dd890bee849262db6438e83700d5784f 100644 --- a/runtime/parsec/codelets/codelet_zgeadd.c +++ b/runtime/parsec/codelets/codelet_zgeadd.c @@ -4,17 +4,17 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgelqt.c b/runtime/parsec/codelets/codelet_zgelqt.c index 966d919fe4f59f6ecefd93a199263d01f28dc8f7..b70a695f8b4a2e4f96a43b026e1fe345c6494ec2 100644 --- a/runtime/parsec/codelets/codelet_zgelqt.c +++ b/runtime/parsec/codelets/codelet_zgelqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgemm.c b/runtime/parsec/codelets/codelet_zgemm.c index 267033bc73e5bb8c4c795fd6954343db3abcac86..c1066e3ec9eb2bd55ca7f3e63ace92b06114d708 100644 --- a/runtime/parsec/codelets/codelet_zgemm.c +++ b/runtime/parsec/codelets/codelet_zgemm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgeqrt.c b/runtime/parsec/codelets/codelet_zgeqrt.c index 9a514361ba8f26f5b126bef4410af55310fdac88..cb8b00e30f9c468640559d6cfc5f0e08d2600218 100644 --- a/runtime/parsec/codelets/codelet_zgeqrt.c +++ b/runtime/parsec/codelets/codelet_zgeqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgessm.c b/runtime/parsec/codelets/codelet_zgessm.c index 3893d377021d5ddf4614620355b45cccf7bc9a83..477d6f5b9d9b3983825ff7414fe40387a70b9d7b 100644 --- a/runtime/parsec/codelets/codelet_zgessm.c +++ b/runtime/parsec/codelets/codelet_zgessm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgessq.c b/runtime/parsec/codelets/codelet_zgessq.c index 4a74f16a27825b0f1aaae29408f4c97de9c5bb3e..799f6adcbefca61cdfb4acf0d54e266e710f6dbb 100644 --- a/runtime/parsec/codelets/codelet_zgessq.c +++ b/runtime/parsec/codelets/codelet_zgessq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgetrf.c b/runtime/parsec/codelets/codelet_zgetrf.c index 3f02a3d4549cbe94a50a62dd401a326191dcaa60..5343f8625cbdacc6b4b129c21cc2d3b6dcfce178 100644 --- a/runtime/parsec/codelets/codelet_zgetrf.c +++ b/runtime/parsec/codelets/codelet_zgetrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgetrf_incpiv.c b/runtime/parsec/codelets/codelet_zgetrf_incpiv.c index d328f2e774e07f1ed2fb7366585098ce08f9ab7a..782bd5fc50726402a0f8900c60a87d8e087c0fcc 100644 --- a/runtime/parsec/codelets/codelet_zgetrf_incpiv.c +++ b/runtime/parsec/codelets/codelet_zgetrf_incpiv.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_incpiv PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgetrf_nopiv.c b/runtime/parsec/codelets/codelet_zgetrf_nopiv.c index 867a24b9d1e866c3e43e8cb3197ba69d268b8eb4..96aaaf2780a70d46572cc45eaab00120d64b4b56 100644 --- a/runtime/parsec/codelets/codelet_zgetrf_nopiv.c +++ b/runtime/parsec/codelets/codelet_zgetrf_nopiv.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zgram.c b/runtime/parsec/codelets/codelet_zgram.c index ddba740357c9d521ad2a0d3a9ae28bdf153a14ce..2a9e0652474ccf5f6781b3e25b25326901d975f1 100644 --- a/runtime/parsec/codelets/codelet_zgram.c +++ b/runtime/parsec/codelets/codelet_zgram.c @@ -2,17 +2,17 @@ * * @file parsec/codelet_zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-11 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zhe2ge.c b/runtime/parsec/codelets/codelet_zhe2ge.c index 2b8b6ad242309002d51be8031eab5ca78bdf5ddc..8a6d06b136536c10b996fcd1c630fd442662ea16 100644 --- a/runtime/parsec/codelets/codelet_zhe2ge.c +++ b/runtime/parsec/codelets/codelet_zhe2ge.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhe2ge PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zhemm.c b/runtime/parsec/codelets/codelet_zhemm.c index e3fe539cb74b460000f35ef5580a6d5383256299..d6cb6628e43a3d8a8e3bdc57feaabfb6e63d66e5 100644 --- a/runtime/parsec/codelets/codelet_zhemm.c +++ b/runtime/parsec/codelets/codelet_zhemm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zher2k.c b/runtime/parsec/codelets/codelet_zher2k.c index 10599009c9ca1b76c54f630815f30bd138bc0af8..8bbdf0c8366b7b31611dd13d4287e19d281fa25f 100644 --- a/runtime/parsec/codelets/codelet_zher2k.c +++ b/runtime/parsec/codelets/codelet_zher2k.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zherfb.c b/runtime/parsec/codelets/codelet_zherfb.c index 0b6d3d649c1b769e6aa9f00930dfddf967bfe774..2a188248d407c28e0da3d78932700d03476bca3a 100644 --- a/runtime/parsec/codelets/codelet_zherfb.c +++ b/runtime/parsec/codelets/codelet_zherfb.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_blas PaRSEC wrapper * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zherk.c b/runtime/parsec/codelets/codelet_zherk.c index 45822a1e2080b40ec6ac787db28b38ab6fa1f66d..419e5b84896166f493efe31d3373091a5c67de23 100644 --- a/runtime/parsec/codelets/codelet_zherk.c +++ b/runtime/parsec/codelets/codelet_zherk.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zhessq.c b/runtime/parsec/codelets/codelet_zhessq.c index 5cd16be91efceb988fa1a8d2faf8caad5df5963a..e7928945123bbe168b242b01a21547dfe012c8cd 100644 --- a/runtime/parsec/codelets/codelet_zhessq.c +++ b/runtime/parsec/codelets/codelet_zhessq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhessq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zlacpy.c b/runtime/parsec/codelets/codelet_zlacpy.c index 62b5ffa3682dd7969b1884f2799f3c3935fa13a8..dbea829cea1cd06a384853a3bbec09fe2f751a3d 100644 --- a/runtime/parsec/codelets/codelet_zlacpy.c +++ b/runtime/parsec/codelets/codelet_zlacpy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlag2c.c b/runtime/parsec/codelets/codelet_zlag2c.c index 535849fc88b9659cb8e99dd45e18fbde6542acc9..7365efc35c356bc5e2398b72bf07d97c1ac880db 100644 --- a/runtime/parsec/codelets/codelet_zlag2c.c +++ b/runtime/parsec/codelets/codelet_zlag2c.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlag2c PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlange.c b/runtime/parsec/codelets/codelet_zlange.c index 776ea85e557c99bbf77ebcd6c5f042cf30840f1b..0b15f19fa5251a01852dc14d1ed63af95c804346 100644 --- a/runtime/parsec/codelets/codelet_zlange.c +++ b/runtime/parsec/codelets/codelet_zlange.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlanhe.c b/runtime/parsec/codelets/codelet_zlanhe.c index 02a9d50bc9b215a1f5ee61ddeae5ef7569373d67..3d9c4cfa29821bd35688ac707163ee6c17b42cac 100644 --- a/runtime/parsec/codelets/codelet_zlanhe.c +++ b/runtime/parsec/codelets/codelet_zlanhe.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zlansy.c b/runtime/parsec/codelets/codelet_zlansy.c index 425bcc99230d40d0f250d5cfe6b23377ff5ea03f..5864bfcedf564c7bc780cd60cd9be85430686f68 100644 --- a/runtime/parsec/codelets/codelet_zlansy.c +++ b/runtime/parsec/codelets/codelet_zlansy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlantr.c b/runtime/parsec/codelets/codelet_zlantr.c index 650f5c71b6263d50ffd219123951c62289114fd7..039f393f27e6f6f9a395362cde893e5029aec0c3 100644 --- a/runtime/parsec/codelets/codelet_zlantr.c +++ b/runtime/parsec/codelets/codelet_zlantr.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlascal.c b/runtime/parsec/codelets/codelet_zlascal.c index 32456e8c798dda40d2e01682cffb51a643af4184..60843b807c6dc736ee1490581d4562ed8743bc36 100644 --- a/runtime/parsec/codelets/codelet_zlascal.c +++ b/runtime/parsec/codelets/codelet_zlascal.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlaset.c b/runtime/parsec/codelets/codelet_zlaset.c index 8190891aadac71cf7bc2f226f27a435238b8e84e..6f79f39fa1dc5b2e5c107a3509b51ad6f3767246 100644 --- a/runtime/parsec/codelets/codelet_zlaset.c +++ b/runtime/parsec/codelets/codelet_zlaset.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlaset2.c b/runtime/parsec/codelets/codelet_zlaset2.c index 46067a65fa1267c0bcd23b0f3d685d16d5af0008..72376a5a115298db9e091873edd10322c67e9b2f 100644 --- a/runtime/parsec/codelets/codelet_zlaset2.c +++ b/runtime/parsec/codelets/codelet_zlaset2.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset2 PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlatro.c b/runtime/parsec/codelets/codelet_zlatro.c index 9451ea48a67b2e87d4fef19993e64785b3ad0322..ecc190850f7f4720eebdac243d38d5bdaf920a68 100644 --- a/runtime/parsec/codelets/codelet_zlatro.c +++ b/runtime/parsec/codelets/codelet_zlatro.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon core_blas PaRSEC wrapper * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zlauum.c b/runtime/parsec/codelets/codelet_zlauum.c index 45098a1ff024cea672b48a7063361842a63c3652..aae4b15f111f5f0c546427e047dc81c4e7ae26ae 100644 --- a/runtime/parsec/codelets/codelet_zlauum.c +++ b/runtime/parsec/codelets/codelet_zlauum.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zplghe.c b/runtime/parsec/codelets/codelet_zplghe.c index 40d3aa614ff6a042b25f5f380d4ed2d4b9a2e543..f896e709d04eda550e8826d79101d6517bdae16a 100644 --- a/runtime/parsec/codelets/codelet_zplghe.c +++ b/runtime/parsec/codelets/codelet_zplghe.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_zplgsy.c b/runtime/parsec/codelets/codelet_zplgsy.c index 53e6f2b310f76ff9c4dc58740d7b00691094a906..57fe3ae7fd679b5ce2b56d43fb179fe160167f05 100644 --- a/runtime/parsec/codelets/codelet_zplgsy.c +++ b/runtime/parsec/codelets/codelet_zplgsy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zplrnt.c b/runtime/parsec/codelets/codelet_zplrnt.c index b1e97221d0cb5dfce8aece73a236867ef41f7916..8e6f7d6e904ce5f9a23a5b76df43a21483237c85 100644 --- a/runtime/parsec/codelets/codelet_zplrnt.c +++ b/runtime/parsec/codelets/codelet_zplrnt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zplssq.c b/runtime/parsec/codelets/codelet_zplssq.c index 96ef96dd5fbf51898396e9d79f7d64f32226b8bb..0353105fd4be6c6336541f1e3a56f69128008d22 100644 --- a/runtime/parsec/codelets/codelet_zplssq.c +++ b/runtime/parsec/codelets/codelet_zplssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplssq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zpotrf.c b/runtime/parsec/codelets/codelet_zpotrf.c index 93fdbf4a3326f1785f57262d26a1a18c397e2a96..cfed0a691b651df63c5749c8ceb1628ea23a2d19 100644 --- a/runtime/parsec/codelets/codelet_zpotrf.c +++ b/runtime/parsec/codelets/codelet_zpotrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zssssm.c b/runtime/parsec/codelets/codelet_zssssm.c index e11a2131bee6f81748d1840d7e3bc966643c0e1c..97ad11e85d95a840f57a47be80b81491326779cd 100644 --- a/runtime/parsec/codelets/codelet_zssssm.c +++ b/runtime/parsec/codelets/codelet_zssssm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zssssm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zsymm.c b/runtime/parsec/codelets/codelet_zsymm.c index 75e879049762f8109256020f6bc083fc70a4d834..b4607c403662728f94fdf0343d2fca163e389134 100644 --- a/runtime/parsec/codelets/codelet_zsymm.c +++ b/runtime/parsec/codelets/codelet_zsymm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zsyr2k.c b/runtime/parsec/codelets/codelet_zsyr2k.c index dfe1bc26a24ff2e8ccf9e1d876fb5da20cb414a2..b1f713c9a76f3814cfb9eb7bc61163e86551ed66 100644 --- a/runtime/parsec/codelets/codelet_zsyr2k.c +++ b/runtime/parsec/codelets/codelet_zsyr2k.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zsyrk.c b/runtime/parsec/codelets/codelet_zsyrk.c index 26d4352e28e020ee6529c37d94d70bcfab321b3f..99dc66479a1cf6314f817868a05055f6f7daae97 100644 --- a/runtime/parsec/codelets/codelet_zsyrk.c +++ b/runtime/parsec/codelets/codelet_zsyrk.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zsyssq.c b/runtime/parsec/codelets/codelet_zsyssq.c index c4d570e4c55249f46b247b585fccc07303df2721..4797b1bec3835bb69d456b78b78c522ffd5ddf7f 100644 --- a/runtime/parsec/codelets/codelet_zsyssq.c +++ b/runtime/parsec/codelets/codelet_zsyssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyssq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zsytrf_nopiv.c b/runtime/parsec/codelets/codelet_zsytrf_nopiv.c index 773fbcbc154b31351c613f6a11100bf7b1306153..c6fb5a52fe8a64304031972335b62ba5b852fbd4 100644 --- a/runtime/parsec/codelets/codelet_zsytrf_nopiv.c +++ b/runtime/parsec/codelets/codelet_zsytrf_nopiv.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf_nopiv PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/parsec/codelets/codelet_ztplqt.c b/runtime/parsec/codelets/codelet_ztplqt.c index 1d97ccd4a6ce49de3488232331c83aec752a0329..a8b74e2dbebff3cfe1905eddb29e43830abc0ced 100644 --- a/runtime/parsec/codelets/codelet_ztplqt.c +++ b/runtime/parsec/codelets/codelet_ztplqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztplqt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/parsec/codelets/codelet_ztpmlqt.c b/runtime/parsec/codelets/codelet_ztpmlqt.c index bf4b83472d97b544ffc8fef5971bf6c78502a8b8..4148f44cf429f0c68d404b82168e57fd79b73bcb 100644 --- a/runtime/parsec/codelets/codelet_ztpmlqt.c +++ b/runtime/parsec/codelets/codelet_ztpmlqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpmlqt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/parsec/codelets/codelet_ztpmqrt.c b/runtime/parsec/codelets/codelet_ztpmqrt.c index bacc8fbd2a22163a9b0bd51c8885c4b660d3d0c3..a5a95e9196537bc77b4163b81444e205ffae6df2 100644 --- a/runtime/parsec/codelets/codelet_ztpmqrt.c +++ b/runtime/parsec/codelets/codelet_ztpmqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpmqrt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/parsec/codelets/codelet_ztpqrt.c b/runtime/parsec/codelets/codelet_ztpqrt.c index e552b6da98e7aadcebfb46d55c76be615a3066c9..fbfcd41d6dc147c0974cae7a192c5542c3e08713 100644 --- a/runtime/parsec/codelets/codelet_ztpqrt.c +++ b/runtime/parsec/codelets/codelet_ztpqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpqrt PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/parsec/codelets/codelet_ztradd.c b/runtime/parsec/codelets/codelet_ztradd.c index 825b71a01f9595a9acd70a8abfa37d0948c6e180..26ab6b997be5230edb624a50965573b40589a30a 100644 --- a/runtime/parsec/codelets/codelet_ztradd.c +++ b/runtime/parsec/codelets/codelet_ztradd.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztrasm.c b/runtime/parsec/codelets/codelet_ztrasm.c index 71ceb01ebc8e0b966af20b003015e6e6ac3bf8d9..37f52536b3d3c34a230c74f445d0cbd710c324dd 100644 --- a/runtime/parsec/codelets/codelet_ztrasm.c +++ b/runtime/parsec/codelets/codelet_ztrasm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrasm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztrmm.c b/runtime/parsec/codelets/codelet_ztrmm.c index 449647bfd6b98845af8fa0ae85475429bfcd9eb0..187eff2e945ede37508986a273458e73cea1f1c3 100644 --- a/runtime/parsec/codelets/codelet_ztrmm.c +++ b/runtime/parsec/codelets/codelet_ztrmm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztrsm.c b/runtime/parsec/codelets/codelet_ztrsm.c index 64bff731bf45c46f8d936a47fa50229eaa8e6806..c4e92deddb2f3ffa22ca072258c3583dbc32d995 100644 --- a/runtime/parsec/codelets/codelet_ztrsm.c +++ b/runtime/parsec/codelets/codelet_ztrsm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztrssq.c b/runtime/parsec/codelets/codelet_ztrssq.c index b3e1f25885f004a249f6d2aaa559a31dcf390cac..d614757fca2828f27198a18ad0d014603f75441c 100644 --- a/runtime/parsec/codelets/codelet_ztrssq.c +++ b/runtime/parsec/codelets/codelet_ztrssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrssq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztrtri.c b/runtime/parsec/codelets/codelet_ztrtri.c index e91aa9acec64fdcac7783a9e2d6e418a570ff16c..45a8602639227401793058f0def002a147329f3a 100644 --- a/runtime/parsec/codelets/codelet_ztrtri.c +++ b/runtime/parsec/codelets/codelet_ztrtri.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztsmlq_hetra1.c b/runtime/parsec/codelets/codelet_ztsmlq_hetra1.c index b37325c2f67b23a1711d2e87dde81eb796f80e19..e52e050661789810eb9d91cc5e5477e397c70930 100644 --- a/runtime/parsec/codelets/codelet_ztsmlq_hetra1.c +++ b/runtime/parsec/codelets/codelet_ztsmlq_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmlq_hetra1 PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Jakub Kurzak * @author Azzam Haidar - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztsmqr_hetra1.c b/runtime/parsec/codelets/codelet_ztsmqr_hetra1.c index 4e04d8b4b5b49ebc1d27a2ba3fdc9ac36ebd275b..02eb003beffd44e10030f22d10b9316e7e78a2f1 100644 --- a/runtime/parsec/codelets/codelet_ztsmqr_hetra1.c +++ b/runtime/parsec/codelets/codelet_ztsmqr_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmqr_hetra1 PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Jakub Kurzak * @author Azzam Haidar - * @date 2016-12-15 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_ztstrf.c b/runtime/parsec/codelets/codelet_ztstrf.c index b489bab07aaef59b9b58a11e92f74d8cff8f2bc2..24fe7c5f1ce228fe8ae54cb29b5a7b1e1ed122e9 100644 --- a/runtime/parsec/codelets/codelet_ztstrf.c +++ b/runtime/parsec/codelets/codelet_ztstrf.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztstrf PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zunmlq.c b/runtime/parsec/codelets/codelet_zunmlq.c index 13866d1921f114f30365fd282813db2077021985..07dc604af2a6d4c4b801d8245401feca2240884b 100644 --- a/runtime/parsec/codelets/codelet_zunmlq.c +++ b/runtime/parsec/codelets/codelet_zunmlq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/codelets/codelet_zunmqr.c b/runtime/parsec/codelets/codelet_zunmqr.c index 2e5ff664fbe8f6fc33565481bd964e911bdc447e..9b3702d6bd8879c18a748157afa6ce54aed45407 100644 --- a/runtime/parsec/codelets/codelet_zunmqr.c +++ b/runtime/parsec/codelets/codelet_zunmqr.c @@ -4,16 +4,16 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr PaRSEC codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque - * @date 2015-11-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/parsec/control/runtime_async.c b/runtime/parsec/control/runtime_async.c index b28a034a69a48bc4f5979c2ebe50b15fcd40b71c..657b2078a72b5015285b07426f142060ea9c8746 100644 --- a/runtime/parsec/control/runtime_async.c +++ b/runtime/parsec/control/runtime_async.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC asynchronous routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/parsec/control/runtime_context.c b/runtime/parsec/control/runtime_context.c index 41ad7df210a8098f9a5d302eeefe37c0020ba2e9..1ce209a973fa559c1e858789f971dbdf58351d05 100644 --- a/runtime/parsec/control/runtime_context.c +++ b/runtime/parsec/control/runtime_context.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC context routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/parsec/control/runtime_control.c b/runtime/parsec/control/runtime_control.c index b69f7d8c8bcc8742ed1a5ca716590afe8a2e2778..d6840253a9b1e5def534300650066606a3370742 100644 --- a/runtime/parsec/control/runtime_control.c +++ b/runtime/parsec/control/runtime_control.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC control routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include <stdio.h> diff --git a/runtime/parsec/control/runtime_descriptor.c b/runtime/parsec/control/runtime_descriptor.c index 05993c68a90866b8dc97ea18b4f55e3482885812..06f408911e7f0bdbc2bed2eac693fdcb568c2520 100644 --- a/runtime/parsec/control/runtime_descriptor.c +++ b/runtime/parsec/control/runtime_descriptor.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC descriptor routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/parsec/control/runtime_options.c b/runtime/parsec/control/runtime_options.c index 0bfbbcb29c26bdd607264d7a1b97f4e087f77efb..2a161432520ed8845529d5c60b975ad7daca2794 100644 --- a/runtime/parsec/control/runtime_options.c +++ b/runtime/parsec/control/runtime_options.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC options routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include <stdio.h> diff --git a/runtime/parsec/control/runtime_profiling.c b/runtime/parsec/control/runtime_profiling.c index c8f9700057dc044e872db4df8a26a4478fe17878..1e72b15ee144eaa49f42521b28b0bef7e503e035 100644 --- a/runtime/parsec/control/runtime_profiling.c +++ b/runtime/parsec/control/runtime_profiling.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC profiling routines * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include "chameleon_parsec.h" diff --git a/runtime/parsec/control/runtime_zlocality.c b/runtime/parsec/control/runtime_zlocality.c index f381354ef8670bf5ff9da53d85ba3986dae4ca9d..06d22db22e0b8e6fbb34e51be9aed6b262b0c22a 100644 --- a/runtime/parsec/control/runtime_zlocality.c +++ b/runtime/parsec/control/runtime_zlocality.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC CHAMELEON_Complex64_t kernel locality management * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include "runtime/PaRSEC/include/chameleon_parsec.h" diff --git a/runtime/parsec/control/runtime_zprofiling.c b/runtime/parsec/control/runtime_zprofiling.c index 85109d950ccb9c70be80048cb71e5bba512ba968..30c7dd0532f50216dd7beffc43a62b77d5b1f0b1 100644 --- a/runtime/parsec/control/runtime_zprofiling.c +++ b/runtime/parsec/control/runtime_zprofiling.c @@ -4,17 +4,17 @@ * * @copyright 2012-2017 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC CHAMELEON_Complex64_t kernel progiling * - * @version 0.9.2 + * @version 1.0.0 * @author Reazul Hoque * @author Mathieu Faverge - * @date 2015-11-04 + * @date 2020-03-03 * */ #include "chameleon_parsec.h" diff --git a/runtime/parsec/include/chameleon_parsec.h b/runtime/parsec/include/chameleon_parsec.h index 1d2a035c695e3a13198e1cd718a036369e1a2a33..8bc8e4ec076b8db6bf7fb624921a7c750c467b6c 100644 --- a/runtime/parsec/include/chameleon_parsec.h +++ b/runtime/parsec/include/chameleon_parsec.h @@ -4,17 +4,17 @@ * * @copyright 2009-2015 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon PaRSEC runtime header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Reazul Hoque - * @date 2017-07-31 + * @date 2020-03-03 * */ #ifndef _chameleon_parsec_h_ diff --git a/runtime/quark/CMakeLists.txt b/runtime/quark/CMakeLists.txt index 83a38ad37b0bcab187d47e4c7d715f444464ded1..347279ce02c7f7757dde41719e068b911da65169 100644 --- a/runtime/quark/CMakeLists.txt +++ b/runtime/quark/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2015 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-16 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 2.8) diff --git a/runtime/quark/codelets/codelet_dzasum.c b/runtime/quark/codelets/codelet_dzasum.c index 86b1a6e2b8583ecec039d015da45128c5c7c3d96..6d557e53de7315fffa3bcbc6975c8944562cde10 100644 --- a/runtime/quark/codelets/codelet_dzasum.c +++ b/runtime/quark/codelets/codelet_dzasum.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon dzasum Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_map.c b/runtime/quark/codelets/codelet_map.c index 5b6ed1ac8dfa5fa80e49a85637ef52c1a978eeb5..fd84dfb75f2fabe65591a6cc35a20f86e14ed923 100644 --- a/runtime/quark/codelets/codelet_map.c +++ b/runtime/quark/codelets/codelet_map.c @@ -2,16 +2,16 @@ * * @file quark/codelet_map.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-09-25 + * @date 2020-03-03 * */ #include "chameleon_quark.h" diff --git a/runtime/quark/codelets/codelet_zaxpy.c b/runtime/quark/codelets/codelet_zaxpy.c index 6e77e3ca1a2c6f9874e00efd63271114f03845a2..04cc7fad949fa01e50a62563081ce4b8cc1617f8 100644 --- a/runtime/quark/codelets/codelet_zaxpy.c +++ b/runtime/quark/codelets/codelet_zaxpy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zaxpy Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zbuild.c b/runtime/quark/codelets/codelet_zbuild.c index ff2de7675e62a5630c2549c989f59dadc353b0fa..523a3bc32453cd835f1aebd5a7259a77e0222a0a 100644 --- a/runtime/quark/codelets/codelet_zbuild.c +++ b/runtime/quark/codelets/codelet_zbuild.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zbuild Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Piotr Luszczek * @author Pierre Lemarinier * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Guillaume Sylvand - * @date 2016-09-08 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgeadd.c b/runtime/quark/codelets/codelet_zgeadd.c index 4e0aef869dac6a9557d577a9519d546a69d953d3..d95e443814b94c21a81990aceceae59751155f2b 100644 --- a/runtime/quark/codelets/codelet_zgeadd.c +++ b/runtime/quark/codelets/codelet_zgeadd.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgelqt.c b/runtime/quark/codelets/codelet_zgelqt.c index d294df89ba89e09db2c45e7aa8081e5670699d0b..7a12853b86391d192cb8f35c64bcc8fa7244b841 100644 --- a/runtime/quark/codelets/codelet_zgelqt.c +++ b/runtime/quark/codelets/codelet_zgelqt.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgemm.c b/runtime/quark/codelets/codelet_zgemm.c index 7bdffae459449ba81628f2f9a6b3f975d2e8fb3a..6def09b52ccce39402397f42c9faaa069329e5e7 100644 --- a/runtime/quark/codelets/codelet_zgemm.c +++ b/runtime/quark/codelets/codelet_zgemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgeqrt.c b/runtime/quark/codelets/codelet_zgeqrt.c index 2cf6d7a328e568f72dff86d0e82ba93820c97c03..52288fc070e6f1f3cd57d14c2c7c70b4088d274e 100644 --- a/runtime/quark/codelets/codelet_zgeqrt.c +++ b/runtime/quark/codelets/codelet_zgeqrt.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgessm.c b/runtime/quark/codelets/codelet_zgessm.c index 5a893bd8549f3d4e77dbde391f25eab915330d70..d69b9fdce8f1ff4cc97fa7091f9c9db5595422b9 100644 --- a/runtime/quark/codelets/codelet_zgessm.c +++ b/runtime/quark/codelets/codelet_zgessm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgessq.c b/runtime/quark/codelets/codelet_zgessq.c index 5ea99fc1f206508b7b641c7d935eb4f0d8870522..ef9db705c480554894a71a0029188125de007044 100644 --- a/runtime/quark/codelets/codelet_zgessq.c +++ b/runtime/quark/codelets/codelet_zgessq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgetrf.c b/runtime/quark/codelets/codelet_zgetrf.c index 8b235b15d4b0a5cc14a61c7ed90e9acaf1868d4c..505abc59a95f03743d579d5b0f698a92a6dff0a1 100644 --- a/runtime/quark/codelets/codelet_zgetrf.c +++ b/runtime/quark/codelets/codelet_zgetrf.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgetrf_incpiv.c b/runtime/quark/codelets/codelet_zgetrf_incpiv.c index 2bac0ee19a3634e9afb4ca9dc936075e921bf92c..faf21cc9cf89e85ca2fc2648996cbb7a1786e349 100644 --- a/runtime/quark/codelets/codelet_zgetrf_incpiv.c +++ b/runtime/quark/codelets/codelet_zgetrf_incpiv.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_incpiv Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgetrf_nopiv.c b/runtime/quark/codelets/codelet_zgetrf_nopiv.c index 130cf7ef41a69e2a4fd012ab68858b2a2115b5da..dba1d9150730a5f278f0df2881386378ef272805 100644 --- a/runtime/quark/codelets/codelet_zgetrf_nopiv.c +++ b/runtime/quark/codelets/codelet_zgetrf_nopiv.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zgram.c b/runtime/quark/codelets/codelet_zgram.c index 2acba7cdd644f3e68d66d1aaaa1ccfa3f5cfbea1..99b75e6190bd0bfd4f43655ead01e29315447083 100644 --- a/runtime/quark/codelets/codelet_zgram.c +++ b/runtime/quark/codelets/codelet_zgram.c @@ -2,17 +2,17 @@ * * @file quark/codelet_zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost - * @date 2019-04-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zhe2ge.c b/runtime/quark/codelets/codelet_zhe2ge.c index ae9ea7e2fac1bc308e7b07c25578c968b735310c..7b4a425665848e1c19035b7a46a5c1d1991ff9e9 100644 --- a/runtime/quark/codelets/codelet_zhe2ge.c +++ b/runtime/quark/codelets/codelet_zhe2ge.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhe2ge Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zhemm.c b/runtime/quark/codelets/codelet_zhemm.c index 0e576a93eb2ae13fb0c94cab15f25672d3cd7463..5ab6412228c9aa9ab0e8e891b436368684356a73 100644 --- a/runtime/quark/codelets/codelet_zhemm.c +++ b/runtime/quark/codelets/codelet_zhemm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zher2k.c b/runtime/quark/codelets/codelet_zher2k.c index 5e0ba7efb3b4406733eeab6a1377c5aa9319f450..bd6437c53ec7861534693eb58655fe487f3b65b9 100644 --- a/runtime/quark/codelets/codelet_zher2k.c +++ b/runtime/quark/codelets/codelet_zher2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zherfb.c b/runtime/quark/codelets/codelet_zherfb.c index 29b525f30278a407f9710c873b59a31c607df3c8..40dcf775dcf1405967e1270d2d2f4bdd9f20d9fd 100644 --- a/runtime/quark/codelets/codelet_zherfb.c +++ b/runtime/quark/codelets/codelet_zherfb.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherfb Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zherk.c b/runtime/quark/codelets/codelet_zherk.c index 8651de4d9c3a9cab50023db08b41384748af2ef8..3d47a8e59f9f12df5fd2282c473e46e04e34f45a 100644 --- a/runtime/quark/codelets/codelet_zherk.c +++ b/runtime/quark/codelets/codelet_zherk.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zhessq.c b/runtime/quark/codelets/codelet_zhessq.c index f58dc4194da704f2537a7ae7046aab799c4f2979..77748f619692466d388f99d437d2124c4c597555 100644 --- a/runtime/quark/codelets/codelet_zhessq.c +++ b/runtime/quark/codelets/codelet_zhessq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhessq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zlacpy.c b/runtime/quark/codelets/codelet_zlacpy.c index 976bc83a79b328514311bf13f08f3af2a5d02409..86b467c5ebcee4d2b6982e0a51236ea67b6359a2 100644 --- a/runtime/quark/codelets/codelet_zlacpy.c +++ b/runtime/quark/codelets/codelet_zlacpy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlag2c.c b/runtime/quark/codelets/codelet_zlag2c.c index 28ac7853cbb6de6c595a547d587b06d8d0c2cd2e..e6bbcbcfdf42326b3d42489bf888c700617839d8 100644 --- a/runtime/quark/codelets/codelet_zlag2c.c +++ b/runtime/quark/codelets/codelet_zlag2c.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlag2c Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/runtime/quark/codelets/codelet_zlange.c b/runtime/quark/codelets/codelet_zlange.c index 608100393ca5d1a12207023508acceb4a98971aa..7df5912e0f6da8323c65004c9acb794e75516058 100644 --- a/runtime/quark/codelets/codelet_zlange.c +++ b/runtime/quark/codelets/codelet_zlange.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlanhe.c b/runtime/quark/codelets/codelet_zlanhe.c index a7c05e812c8ecfaefd1336800bf4d1b5776fe4da..277483da699d2daa8fb3d17baf534502c2b9b5d9 100644 --- a/runtime/quark/codelets/codelet_zlanhe.c +++ b/runtime/quark/codelets/codelet_zlanhe.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zlansy.c b/runtime/quark/codelets/codelet_zlansy.c index 17aecc2320fdad11fac4e891bc1b6f1f0b8933d2..896a20c817adbf0c5ef8f4ad26bebc6da95a4b4d 100644 --- a/runtime/quark/codelets/codelet_zlansy.c +++ b/runtime/quark/codelets/codelet_zlansy.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlantr.c b/runtime/quark/codelets/codelet_zlantr.c index 5a6bdb83333c47fe7fecf9f90da606f14f6d1443..50c61c41c540498584cf0c63e9a3351b5e718dbc 100644 --- a/runtime/quark/codelets/codelet_zlantr.c +++ b/runtime/quark/codelets/codelet_zlantr.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlascal.c b/runtime/quark/codelets/codelet_zlascal.c index 4aebaf8d663b8d6589a91308a9adf60da7a0722b..716c85c6bf2560bd5c70e6027e509fe68a4a023d 100644 --- a/runtime/quark/codelets/codelet_zlascal.c +++ b/runtime/quark/codelets/codelet_zlascal.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2016-11-30 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlaset.c b/runtime/quark/codelets/codelet_zlaset.c index 7c449a02fc8ed34753392c574f3c9bb0c4cc66b5..ca12c20f36457b4225fcf1aae88c957ec45aa4cb 100644 --- a/runtime/quark/codelets/codelet_zlaset.c +++ b/runtime/quark/codelets/codelet_zlaset.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlaset2.c b/runtime/quark/codelets/codelet_zlaset2.c index b8acfd2680a8d958c8384411af9562d725282e30..80e185d5539202bf43ebeb6d7736bb0b51ea5095 100644 --- a/runtime/quark/codelets/codelet_zlaset2.c +++ b/runtime/quark/codelets/codelet_zlaset2.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset2 Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlatro.c b/runtime/quark/codelets/codelet_zlatro.c index 055bee94c90a740c8b200445949371cf6104834f..71fefc651fa320946454b528e0958a9c6165aeea 100644 --- a/runtime/quark/codelets/codelet_zlatro.c +++ b/runtime/quark/codelets/codelet_zlatro.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlatro Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zlauum.c b/runtime/quark/codelets/codelet_zlauum.c index 356fb8adcb24876f9aa2e527aafb3167c0fa52f4..3a8983e2554e1ef2057059363ba956eccdb6570a 100644 --- a/runtime/quark/codelets/codelet_zlauum.c +++ b/runtime/quark/codelets/codelet_zlauum.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zplghe.c b/runtime/quark/codelets/codelet_zplghe.c index eab1f625590a1782b236e7be4e78ebddf1e47a45..9a7e9c9721ab541ce2066caa9695ef81eac97654 100644 --- a/runtime/quark/codelets/codelet_zplghe.c +++ b/runtime/quark/codelets/codelet_zplghe.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Piotr Luszczek * @author Pierre Lemarinier * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_zplgsy.c b/runtime/quark/codelets/codelet_zplgsy.c index 8ed9175fc575ee5564b55c59751d0677ad0cc118..7b6e4f63e7e0b1e70f069ce5d85db4cc40e378e6 100644 --- a/runtime/quark/codelets/codelet_zplgsy.c +++ b/runtime/quark/codelets/codelet_zplgsy.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Piotr Luszczek * @author Pierre Lemarinier * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zplrnt.c b/runtime/quark/codelets/codelet_zplrnt.c index 9f84ba3a47b156cd29d3e0ac076daaa88e3bb0cb..5e7109a23305f3ab68373b487e044fc1d3cba5a1 100644 --- a/runtime/quark/codelets/codelet_zplrnt.c +++ b/runtime/quark/codelets/codelet_zplrnt.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Piotr Luszczek * @author Pierre Lemarinier * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zplssq.c b/runtime/quark/codelets/codelet_zplssq.c index bc985a5a3e79eb400273d63185c96946d631d85c..8c6317f762241e2a6845d8640b5c8da344c31515 100644 --- a/runtime/quark/codelets/codelet_zplssq.c +++ b/runtime/quark/codelets/codelet_zplssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplssq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zpotrf.c b/runtime/quark/codelets/codelet_zpotrf.c index 7b8df563fd922f233ed3d370150659caca144b50..c277343cc8f4ee2e88024a5a0cc6c541d3aacbc4 100644 --- a/runtime/quark/codelets/codelet_zpotrf.c +++ b/runtime/quark/codelets/codelet_zpotrf.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zssssm.c b/runtime/quark/codelets/codelet_zssssm.c index 83ec806967f7fe58bb03a0ca5f2126591498416b..34fd51c63e69aff9a14859d3aeb5a3cfaf730e1e 100644 --- a/runtime/quark/codelets/codelet_zssssm.c +++ b/runtime/quark/codelets/codelet_zssssm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zssssm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zsymm.c b/runtime/quark/codelets/codelet_zsymm.c index b1965360c3b1afb0fc1c313a20a7c63ae5e95990..6bccc1deebdca6e376843a60c66c28c5027aef02 100644 --- a/runtime/quark/codelets/codelet_zsymm.c +++ b/runtime/quark/codelets/codelet_zsymm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zsyr2k.c b/runtime/quark/codelets/codelet_zsyr2k.c index d0306a94284854a10ca5f2eaed20a0de8f8f52d3..0e41e44fa6c9f1e2241d2fb1490fb606b8056a25 100644 --- a/runtime/quark/codelets/codelet_zsyr2k.c +++ b/runtime/quark/codelets/codelet_zsyr2k.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zsyrk.c b/runtime/quark/codelets/codelet_zsyrk.c index 5add74bf7f386a53a2d986ca9ea07dec434bcbbc..d8c272f5013aba1eff3d67fcbbedc69add9c83a0 100644 --- a/runtime/quark/codelets/codelet_zsyrk.c +++ b/runtime/quark/codelets/codelet_zsyrk.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zsyssq.c b/runtime/quark/codelets/codelet_zsyssq.c index 8636e3a69f56698be7feecc081b7ba891824be8d..dd5944359a5a488632a7f803fbe4d032b7e58fce 100644 --- a/runtime/quark/codelets/codelet_zsyssq.c +++ b/runtime/quark/codelets/codelet_zsyssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyssq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zsytrf_nopiv.c b/runtime/quark/codelets/codelet_zsytrf_nopiv.c index 5e3922ec1469fa643d6615ddad251eebc0225854..34f27f333083ef355a2805028c55bc92475f1d7d 100644 --- a/runtime/quark/codelets/codelet_zsytrf_nopiv.c +++ b/runtime/quark/codelets/codelet_zsytrf_nopiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf_nopiv Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge @@ -19,7 +19,7 @@ * @author Cedric Castagnede * @author Florent Pruvost * @author Marc Sergent - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/quark/codelets/codelet_ztplqt.c b/runtime/quark/codelets/codelet_ztplqt.c index 1b31544c6b12655143083cd2581daa24a70904d5..7f7216e4681c9b53a1fd42fa5a3d1d5038a039d7 100644 --- a/runtime/quark/codelets/codelet_ztplqt.c +++ b/runtime/quark/codelets/codelet_ztplqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztplqt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/codelets/codelet_ztpmlqt.c b/runtime/quark/codelets/codelet_ztpmlqt.c index 4fe5df16194e2ceae29f2ccfb19707a613dc4f33..551499e67e15fce4cd0331a9ec1e7e9aee1ab502 100644 --- a/runtime/quark/codelets/codelet_ztpmlqt.c +++ b/runtime/quark/codelets/codelet_ztpmlqt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpmlqt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/codelets/codelet_ztpmqrt.c b/runtime/quark/codelets/codelet_ztpmqrt.c index a7670ec15cb603dcbfc120844b662a6641fc8813..18878f7b6530bc66931d28e84467e4bfdb96b82b 100644 --- a/runtime/quark/codelets/codelet_ztpmqrt.c +++ b/runtime/quark/codelets/codelet_ztpmqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpmqrt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/codelets/codelet_ztpqrt.c b/runtime/quark/codelets/codelet_ztpqrt.c index efecbd2be7a42bd4c859322c2002758ebe706ad4..aea6b8abe38ccf487bcc92661087a89eb27d4c63 100644 --- a/runtime/quark/codelets/codelet_ztpqrt.c +++ b/runtime/quark/codelets/codelet_ztpqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpqrt Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/codelets/codelet_ztradd.c b/runtime/quark/codelets/codelet_ztradd.c index c2f99242d9ba3e7fdfed0ecedf3c9b516452a27e..f3a9e0d24dd2d72dfb866295dfaabee528f12086 100644 --- a/runtime/quark/codelets/codelet_ztradd.c +++ b/runtime/quark/codelets/codelet_ztradd.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztrasm.c b/runtime/quark/codelets/codelet_ztrasm.c index 5ce77d8b1c1df571a7818bbf2ae9dfd9d9172e28..231051fc035a0f4c3f84b41a92977d800c5f4fe8 100644 --- a/runtime/quark/codelets/codelet_ztrasm.c +++ b/runtime/quark/codelets/codelet_ztrasm.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrasm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztrmm.c b/runtime/quark/codelets/codelet_ztrmm.c index ce869b781c6da7238d922e4464a5d197e9a99db1..56d6afada16d189dcf06463cc2c93ef73cb958b3 100644 --- a/runtime/quark/codelets/codelet_ztrmm.c +++ b/runtime/quark/codelets/codelet_ztrmm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztrsm.c b/runtime/quark/codelets/codelet_ztrsm.c index 5c9b068502a4f8a65bc2cd60c43f6c727b9ab802..08293b74a77cd6f788fe6a0999754e53734a545b 100644 --- a/runtime/quark/codelets/codelet_ztrsm.c +++ b/runtime/quark/codelets/codelet_ztrsm.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztrssq.c b/runtime/quark/codelets/codelet_ztrssq.c index fc9b34497067b430a9a527f312ed0e746ebbf9e9..e3d4cd861dc8aaca77aadd6f94dffc93681639ea 100644 --- a/runtime/quark/codelets/codelet_ztrssq.c +++ b/runtime/quark/codelets/codelet_ztrssq.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrssq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztrtri.c b/runtime/quark/codelets/codelet_ztrtri.c index 650dc8d19849ae5c8b4ceb47a16035cee6af42b3..5576b45cd964b0811dd84f92552eddab1ca6feab 100644 --- a/runtime/quark/codelets/codelet_ztrtri.c +++ b/runtime/quark/codelets/codelet_ztrtri.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztsmlq_hetra1.c b/runtime/quark/codelets/codelet_ztsmlq_hetra1.c index 4349c864f29056ae4e7d01e386069f9d5479001a..36212b2f195aef088b4fb0650df75ed2d666459c 100644 --- a/runtime/quark/codelets/codelet_ztsmlq_hetra1.c +++ b/runtime/quark/codelets/codelet_ztsmlq_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmlq_hetra1 Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Jakub Kurzak * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztsmqr_hetra1.c b/runtime/quark/codelets/codelet_ztsmqr_hetra1.c index 934338eea8e50313b75b15e3a053ce9a0e24d3e0..bb7f7c150754e4207e55a2ef1665fa53b4f4ad2c 100644 --- a/runtime/quark/codelets/codelet_ztsmqr_hetra1.c +++ b/runtime/quark/codelets/codelet_ztsmqr_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmqr_hetra1 Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Jakub Kurzak * @author Azzam Haidar - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_ztstrf.c b/runtime/quark/codelets/codelet_ztstrf.c index 1bc4a8d357ef4313ea48b9cdb7f5e0bd189d8301..e1d0dc89135c0dfb81410d015a0d3619bd609d73 100644 --- a/runtime/quark/codelets/codelet_ztstrf.c +++ b/runtime/quark/codelets/codelet_ztstrf.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztstrf Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zunmlq.c b/runtime/quark/codelets/codelet_zunmlq.c index eb884f674db48022692570a85b35cf61ce57dc4d..714645d0d318047eb3fa2f505aba4177203e6116 100644 --- a/runtime/quark/codelets/codelet_zunmlq.c +++ b/runtime/quark/codelets/codelet_zunmlq.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Dulceneia Becker * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/codelets/codelet_zunmqr.c b/runtime/quark/codelets/codelet_zunmqr.c index 2cabe00f57c1ac31ab8b4d519e61d0ca7afb10c9..e1a0fb63370f27f92df6a39754a3b16ad0bef43e 100644 --- a/runtime/quark/codelets/codelet_zunmqr.c +++ b/runtime/quark/codelets/codelet_zunmqr.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr Quark codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/quark/control/runtime_async.c b/runtime/quark/control/runtime_async.c index fcb84fd326a473a8608bb7ced138eb615cbc8d11..f6f466f0223668d5ae8cd9a30a59aea894e643e5 100644 --- a/runtime/quark/control/runtime_async.c +++ b/runtime/quark/control/runtime_async.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark asynchronous routines * - * @version 0.9.2 + * @version 1.0.0 * @author Jakub Kurzak * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/quark/control/runtime_context.c b/runtime/quark/control/runtime_context.c index d84ddf00d2416360e61edd2b1e0dc873eed6c2d2..120f6b707826444ca33fb58e4752aa225a4e4b13 100644 --- a/runtime/quark/control/runtime_context.c +++ b/runtime/quark/control/runtime_context.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark context routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/quark/control/runtime_control.c b/runtime/quark/control/runtime_control.c index e153b908111e1964789465787d7cbccd0491c3c1..cfc447329696b02e127715609138f1e655663d48 100644 --- a/runtime/quark/control/runtime_control.c +++ b/runtime/quark/control/runtime_control.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark control routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdio.h> diff --git a/runtime/quark/control/runtime_descriptor.c b/runtime/quark/control/runtime_descriptor.c index b09e44165b3496ccaf4b8e9d15713aeb01d04e0e..35c7f7f576aaa5b99fb7be4badfdf43b78023368 100644 --- a/runtime/quark/control/runtime_descriptor.c +++ b/runtime/quark/control/runtime_descriptor.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark descriptor routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/quark/control/runtime_options.c b/runtime/quark/control/runtime_options.c index 816319870679e1889d1d0e3589b32284ab33aec7..7d6131ac861efdacf9bf5b27374677cdf4b30ef9 100644 --- a/runtime/quark/control/runtime_options.c +++ b/runtime/quark/control/runtime_options.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark options routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdio.h> diff --git a/runtime/quark/control/runtime_profiling.c b/runtime/quark/control/runtime_profiling.c index 10da952b0d3c6e5be0a0e017452a40dbb2dc4f2c..049be16b71bc028045a43d56cbb83155107da898 100644 --- a/runtime/quark/control/runtime_profiling.c +++ b/runtime/quark/control/runtime_profiling.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark profiling routines * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include "chameleon_quark.h" diff --git a/runtime/quark/control/runtime_zlocality.c b/runtime/quark/control/runtime_zlocality.c index b0f4bfca2f72d7eeb34c3f9496af208446180656..65ca43bbe667ab9d40ca674b64e83ab3f1886850 100644 --- a/runtime/quark/control/runtime_zlocality.c +++ b/runtime/quark/control/runtime_zlocality.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark CHAMELEON_Complex64_t kernel locality management * - * @version 0.9.2 + * @version 1.0.0 * @author Vijay Joshi - * @date 2015-05-22 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/control/runtime_zprofiling.c b/runtime/quark/control/runtime_zprofiling.c index 9e9ccea93ffba578ad803689c3aed794382fdb7e..e4752c965de60ca142218c32677e83a31a62ec06 100644 --- a/runtime/quark/control/runtime_zprofiling.c +++ b/runtime/quark/control/runtime_zprofiling.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark CHAMELEON_Complex64_t kernel progiling * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/quark/include/chameleon_quark.h b/runtime/quark/include/chameleon_quark.h index 03e0f50f54d66a6f252e990bdc6a82e174b7fbdb..11c3942584463590e2747505ffe74e4516edbedb 100644 --- a/runtime/quark/include/chameleon_quark.h +++ b/runtime/quark/include/chameleon_quark.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark runtime main header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2017-07-31 + * @date 2020-03-03 * */ #ifndef _chameleon_quark_h_ diff --git a/runtime/quark/include/core_blas_dag.h b/runtime/quark/include/core_blas_dag.h index acc7ca8a120651d38deece54c9e3ebae9b9a855f..bc366076816d0f27dbad004a1f1e9b68259f9721 100644 --- a/runtime/quark/include/core_blas_dag.h +++ b/runtime/quark/include/core_blas_dag.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon Quark DAG generation header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ #ifndef _core_blas_dag_h_ diff --git a/runtime/starpu/CMakeLists.txt b/runtime/starpu/CMakeLists.txt index 924d480e81ed08fc4cc29ddd4920c64243e5757c..f02a8bbb0e195d2a72fe0503f19f6418a05334d1 100644 --- a/runtime/starpu/CMakeLists.txt +++ b/runtime/starpu/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2015 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,12 +17,12 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge # @author Florent Pruvost -# @date 2014-11-16 +# @date 2020-03-03 # ### cmake_minimum_required(VERSION 2.8) diff --git a/runtime/starpu/codelets/codelet_dzasum.c b/runtime/starpu/codelets/codelet_dzasum.c index 5b2c9827e1292b99fd097246288b795b0c3580ae..67df3e6ef5590c108b680344b63b5a62a956ec77 100644 --- a/runtime/starpu/codelets/codelet_dzasum.c +++ b/runtime/starpu/codelets/codelet_dzasum.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon dzasum StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_map.c b/runtime/starpu/codelets/codelet_map.c index bab6a097cf046ef7aeed306bb6b14830449b3504..347a76ed407fa55b54ee2d77deeb5e403d11be5f 100644 --- a/runtime/starpu/codelets/codelet_map.c +++ b/runtime/starpu/codelets/codelet_map.c @@ -2,16 +2,16 @@ * * @file starpu/codelet_map.c * - * @copyright 2018-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2018-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon map StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2018-09-24 + * @date 2020-03-03 * */ #include "chameleon_starpu.h" diff --git a/runtime/starpu/codelets/codelet_zaxpy.c b/runtime/starpu/codelets/codelet_zaxpy.c index 3458a9968acc2de81ed12cbf5cd25d2f5be2dd94..f19b201becb18d68cc457d5e909e33179403fcae 100644 --- a/runtime/starpu/codelets/codelet_zaxpy.c +++ b/runtime/starpu/codelets/codelet_zaxpy.c @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zaxpy StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zbuild.c b/runtime/starpu/codelets/codelet_zbuild.c index f0879fddb53aa9d929ff533371aee48fddda4343..a99d48944debd44cc894b01b7f6203b4097af8ad 100644 --- a/runtime/starpu/codelets/codelet_zbuild.c +++ b/runtime/starpu/codelets/codelet_zbuild.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zbuild StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -21,7 +21,7 @@ * @author Cedric Castagnede * @author Guillaume Sylvand * @author Lucas Barros de Assis - * @date 2016-09-08 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zcallback.c b/runtime/starpu/codelets/codelet_zcallback.c index 1aee0b3fe5ff978d9c3b3b5de042af8a332d0d5c..f810ab0f07d92c320459072022496d68906f1c30 100644 --- a/runtime/starpu/codelets/codelet_zcallback.c +++ b/runtime/starpu/codelets/codelet_zcallback.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zcallback StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Florent Pruvost - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgeadd.c b/runtime/starpu/codelets/codelet_zgeadd.c index e6a73fd887431993f95929f904c0fa74fb74a620..495a7273f26ab42e68d786df318e304a04b1f50b 100644 --- a/runtime/starpu/codelets/codelet_zgeadd.c +++ b/runtime/starpu/codelets/codelet_zgeadd.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgelqt.c b/runtime/starpu/codelets/codelet_zgelqt.c index d40413f58562788572b2c497c08e9fc10e226233..d918f81101e65add5b898faf28ddbade6a244c30 100644 --- a/runtime/starpu/codelets/codelet_zgelqt.c +++ b/runtime/starpu/codelets/codelet_zgelqt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgemm.c b/runtime/starpu/codelets/codelet_zgemm.c index 55c480f7c1a1ceff8e1fd225c9af39e9b63090b0..24b46d51476ee521fab40961c6d56b25a8d2e83b 100644 --- a/runtime/starpu/codelets/codelet_zgemm.c +++ b/runtime/starpu/codelets/codelet_zgemm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgeqrt.c b/runtime/starpu/codelets/codelet_zgeqrt.c index ccbdb322e129333b6fe3371ce5d8971e3be86c90..962f28c33520a2a741746d6de3e5c5dcc5230dfd 100644 --- a/runtime/starpu/codelets/codelet_zgeqrt.c +++ b/runtime/starpu/codelets/codelet_zgeqrt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgessm.c b/runtime/starpu/codelets/codelet_zgessm.c index 6d94b0ffb9684cbb171597112ee1a64a9169299a..b93e04dd0f67ca013323175f61b56eec951cba41 100644 --- a/runtime/starpu/codelets/codelet_zgessm.c +++ b/runtime/starpu/codelets/codelet_zgessm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgessq.c b/runtime/starpu/codelets/codelet_zgessq.c index 1a63e1a22e5266d408ae1fc568db75f6c2db242e..16ce389518206ca5bfe97ee27db0396435e953e1 100644 --- a/runtime/starpu/codelets/codelet_zgessq.c +++ b/runtime/starpu/codelets/codelet_zgessq.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgessq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgetrf.c b/runtime/starpu/codelets/codelet_zgetrf.c index b744a43a9de6f0485cc64639e64f3b005eab3284..90482b6f67b076f775e9dc53762b7c5eed3eec94 100644 --- a/runtime/starpu/codelets/codelet_zgetrf.c +++ b/runtime/starpu/codelets/codelet_zgetrf.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgetrf_incpiv.c b/runtime/starpu/codelets/codelet_zgetrf_incpiv.c index 61eef5b399d4ecb661fe95fb8c894a586c98235e..720d94a3781197338951bd6eaab428adf11b4abb 100644 --- a/runtime/starpu/codelets/codelet_zgetrf_incpiv.c +++ b/runtime/starpu/codelets/codelet_zgetrf_incpiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_incpiv StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgetrf_nopiv.c b/runtime/starpu/codelets/codelet_zgetrf_nopiv.c index d6fd0239e8c7ae38a5683a2b2b08dd47e4712861..c32ebc253f1fec34fb08f655acb40201b090c9d9 100644 --- a/runtime/starpu/codelets/codelet_zgetrf_nopiv.c +++ b/runtime/starpu/codelets/codelet_zgetrf_nopiv.c @@ -4,20 +4,20 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf_nopiv StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Omar Zenati * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zgram.c b/runtime/starpu/codelets/codelet_zgram.c index 1aa1833b41c5cbe817a86382047459902222f98b..a1c83f4760014e766f01fec47894d3ab0658455d 100644 --- a/runtime/starpu/codelets/codelet_zgram.c +++ b/runtime/starpu/codelets/codelet_zgram.c @@ -2,18 +2,18 @@ * * @file starpu/codelet_zgram.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgram StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Florent Pruvost * @author Lucas Barros de Assis - * @date 2019-04-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zhe2ge.c b/runtime/starpu/codelets/codelet_zhe2ge.c index cb8f66cd1f3820f7499858f6bb20dd0f140c3dc2..6f01c76135c99980288ed4b813e43419a43fe258 100644 --- a/runtime/starpu/codelets/codelet_zhe2ge.c +++ b/runtime/starpu/codelets/codelet_zhe2ge.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhe2ge StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zhemm.c b/runtime/starpu/codelets/codelet_zhemm.c index db4d7c7f85babe20d7f7bc0eeadafdda0dabcfdd..31a2b87bf463aff8a59e7af109454b499163f919 100644 --- a/runtime/starpu/codelets/codelet_zhemm.c +++ b/runtime/starpu/codelets/codelet_zhemm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zher2k.c b/runtime/starpu/codelets/codelet_zher2k.c index 1e3c2f5b1c9f430ea1872646a028e3f9697b3f0c..de32d9521b32249757f277a1ad9964fcc806cb61 100644 --- a/runtime/starpu/codelets/codelet_zher2k.c +++ b/runtime/starpu/codelets/codelet_zher2k.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zherfb.c b/runtime/starpu/codelets/codelet_zherfb.c index a160d04907897cce2ba9767d009d92c1dc5fc366..e47bfa3ccf0c6afe92c3757bb7aa8603ce2345c4 100644 --- a/runtime/starpu/codelets/codelet_zherfb.c +++ b/runtime/starpu/codelets/codelet_zherfb.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherfb StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Lucas Barros de Assis - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zherk.c b/runtime/starpu/codelets/codelet_zherk.c index bd6131b6b4103ebb1150acb604e3a094a572eef3..d90885b263771bba7be8552179573539a192bf6d 100644 --- a/runtime/starpu/codelets/codelet_zherk.c +++ b/runtime/starpu/codelets/codelet_zherk.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zhessq.c b/runtime/starpu/codelets/codelet_zhessq.c index cb24c4e6925ac784b5ed8561ccd17556c956c181..9f11b0193d79667ea790777e996a17f256754c04 100644 --- a/runtime/starpu/codelets/codelet_zhessq.c +++ b/runtime/starpu/codelets/codelet_zhessq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhessq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zlacpy.c b/runtime/starpu/codelets/codelet_zlacpy.c index d13e6ec088d0a5808354770ef77e894301c04308..144a38c569a133218d4456e21b98b26820cd133a 100644 --- a/runtime/starpu/codelets/codelet_zlacpy.c +++ b/runtime/starpu/codelets/codelet_zlacpy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlag2c.c b/runtime/starpu/codelets/codelet_zlag2c.c index 89b36aa0c00d2f2e4fffb548927a7053d8c92eeb..622aa424da093d06397f62cf2b8323330cff8189 100644 --- a/runtime/starpu/codelets/codelet_zlag2c.c +++ b/runtime/starpu/codelets/codelet_zlag2c.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlag2c StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions mixed zc -> ds * */ diff --git a/runtime/starpu/codelets/codelet_zlange.c b/runtime/starpu/codelets/codelet_zlange.c index 477f364dff7caf95572c7c13ca79a763f82ebc0d..aa11096179edc17e526f1ccafd324e4cd186b763 100644 --- a/runtime/starpu/codelets/codelet_zlange.c +++ b/runtime/starpu/codelets/codelet_zlange.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlanhe.c b/runtime/starpu/codelets/codelet_zlanhe.c index 8b7854127db7349a2336b2a8b8e214aafe4391c3..c5bcc1496bfe723153fece7b66763e42718d8caf 100644 --- a/runtime/starpu/codelets/codelet_zlanhe.c +++ b/runtime/starpu/codelets/codelet_zlanhe.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zlansy.c b/runtime/starpu/codelets/codelet_zlansy.c index 2345339cebd9290d2b77fa31b13567659f7de5f6..e378fdc5f62ac557bd337195a451b00fcfa4c2e3 100644 --- a/runtime/starpu/codelets/codelet_zlansy.c +++ b/runtime/starpu/codelets/codelet_zlansy.c @@ -4,21 +4,21 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Julien Langou * @author Henricus Bouwmeester * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlantr.c b/runtime/starpu/codelets/codelet_zlantr.c index 4d4020d67e6d41f5b7f77613f94b6ed84bfd03c1..8598eb4b637977d209b4aa5436fdbd36ef518eda 100644 --- a/runtime/starpu/codelets/codelet_zlantr.c +++ b/runtime/starpu/codelets/codelet_zlantr.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlascal.c b/runtime/starpu/codelets/codelet_zlascal.c index 58b4d3ad2871f57aef7631818ba269d85ebbc16c..dbf072de129885d7cc5fe4543d2bcfd1651321e1 100644 --- a/runtime/starpu/codelets/codelet_zlascal.c +++ b/runtime/starpu/codelets/codelet_zlascal.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Dalal Sukkari * @author Lucas Barros de Assis - * @date 2016-11-30 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlaset.c b/runtime/starpu/codelets/codelet_zlaset.c index 5aecc3c3a1fade54184a35093e7b99c9c5eaaf7b..71daf564b3231ddf242e5d3a00c26e2c34a011f8 100644 --- a/runtime/starpu/codelets/codelet_zlaset.c +++ b/runtime/starpu/codelets/codelet_zlaset.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlaset2.c b/runtime/starpu/codelets/codelet_zlaset2.c index f9344fc291f26c95a1c1c49069e2d929ea9f3b70..e6fb285583f859813541101dc771f573314fd0e2 100644 --- a/runtime/starpu/codelets/codelet_zlaset2.c +++ b/runtime/starpu/codelets/codelet_zlaset2.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlaset2 StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -19,7 +19,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlatro.c b/runtime/starpu/codelets/codelet_zlatro.c index d3d6a18dc3c614a440c3334c63c76048fd2715af..86696064f30ebf0acfc3f41608529fe06be38238 100644 --- a/runtime/starpu/codelets/codelet_zlatro.c +++ b/runtime/starpu/codelets/codelet_zlatro.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlatro StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zlauum.c b/runtime/starpu/codelets/codelet_zlauum.c index db67785550c6c6c0ca93d37a1d101e7461774a86..4c7911c29365ab83e3b327ffbdd13c0a250ae269 100644 --- a/runtime/starpu/codelets/codelet_zlauum.c +++ b/runtime/starpu/codelets/codelet_zlauum.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zplghe.c b/runtime/starpu/codelets/codelet_zplghe.c index 20da9d0ab75e78e6e0d6379354b3597493302fb7..5b75d66158d98a4f8d91a554e8b2129dabab75b8 100644 --- a/runtime/starpu/codelets/codelet_zplghe.c +++ b/runtime/starpu/codelets/codelet_zplghe.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplghe StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_zplgsy.c b/runtime/starpu/codelets/codelet_zplgsy.c index 4fbc00d7d6f5a4b8968721bd7a08a3e1408b47c5..5b79c6839b7b65a192c4ebb872222ebea9b17802 100644 --- a/runtime/starpu/codelets/codelet_zplgsy.c +++ b/runtime/starpu/codelets/codelet_zplgsy.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplgsy StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zplrnt.c b/runtime/starpu/codelets/codelet_zplrnt.c index 28b82334c073a28e9d4cfedbeae16529f979e822..3f429707864031f46890a72034ed5d9cec0bbf28 100644 --- a/runtime/starpu/codelets/codelet_zplrnt.c +++ b/runtime/starpu/codelets/codelet_zplrnt.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplrnt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Piotr Luszczek @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zplssq.c b/runtime/starpu/codelets/codelet_zplssq.c index 7da4758d7366c3e32a93e550d2a17ddc8793ce1d..65deb638fb29a130eb78a19300123a3b25432fa2 100644 --- a/runtime/starpu/codelets/codelet_zplssq.c +++ b/runtime/starpu/codelets/codelet_zplssq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zplssq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zpotrf.c b/runtime/starpu/codelets/codelet_zpotrf.c index 01ef85d594e64be2db165fac4e9a3f697fe07088..b8b189375ef13ad3e96aeb34f26ea1cb38c3479f 100644 --- a/runtime/starpu/codelets/codelet_zpotrf.c +++ b/runtime/starpu/codelets/codelet_zpotrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zssssm.c b/runtime/starpu/codelets/codelet_zssssm.c index 78275624e8a67c0d6cc6d50ee50622159aa40037..7a3caf86bb9fec7454586c6aad9e86358615b6a7 100644 --- a/runtime/starpu/codelets/codelet_zssssm.c +++ b/runtime/starpu/codelets/codelet_zssssm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zssssm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zsymm.c b/runtime/starpu/codelets/codelet_zsymm.c index 844347ac3b4f75f8c2338c0dbc7c41a239667340..de2aeb22e73cbf60d64ea699af86b3996d069656 100644 --- a/runtime/starpu/codelets/codelet_zsymm.c +++ b/runtime/starpu/codelets/codelet_zsymm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zsyr2k.c b/runtime/starpu/codelets/codelet_zsyr2k.c index 95f5f28a91ed292a79e1e7519580cf325c7d906f..1da32daad22746d712c30525828e0d5133c9c8bb 100644 --- a/runtime/starpu/codelets/codelet_zsyr2k.c +++ b/runtime/starpu/codelets/codelet_zsyr2k.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zsyrk.c b/runtime/starpu/codelets/codelet_zsyrk.c index a9dd529de0e0879e42b794feee8ea02c87df26db..d340e7a7d17a5e703203ba4933839fb411af72ec 100644 --- a/runtime/starpu/codelets/codelet_zsyrk.c +++ b/runtime/starpu/codelets/codelet_zsyrk.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zsyssq.c b/runtime/starpu/codelets/codelet_zsyssq.c index c2d6c8edb81de46be3b9e7ee9efe2583ffce0b79..29283f0b55ebc77dc01d52a30334a3c39e77f220 100644 --- a/runtime/starpu/codelets/codelet_zsyssq.c +++ b/runtime/starpu/codelets/codelet_zsyssq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyssq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zsytrf_nopiv.c b/runtime/starpu/codelets/codelet_zsytrf_nopiv.c index 92e0b60b08704c5c2f1f0b0534dc84ca19d15bca..3293f977acb7870640adedd490d18103b678efb2 100644 --- a/runtime/starpu/codelets/codelet_zsytrf_nopiv.c +++ b/runtime/starpu/codelets/codelet_zsytrf_nopiv.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf_nopiv StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Jakub Kurzak * @author Mathieu Faverge @@ -20,7 +20,7 @@ * @author Florent Pruvost * @author Marc Sergent * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c * */ diff --git a/runtime/starpu/codelets/codelet_ztplqt.c b/runtime/starpu/codelets/codelet_ztplqt.c index 04aca83f3f54d29e3ae5c21e4323d2132bff0749..96f966b8a6b60186432c5bff1c7637c990b4760a 100644 --- a/runtime/starpu/codelets/codelet_ztplqt.c +++ b/runtime/starpu/codelets/codelet_ztplqt.c @@ -4,17 +4,17 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztplqt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/codelets/codelet_ztpmlqt.c b/runtime/starpu/codelets/codelet_ztpmlqt.c index 32cefc983b2db4f5d256657bfb68bbc14c0ec633..c62d453cc675363292efa386219a627b88fb8723 100644 --- a/runtime/starpu/codelets/codelet_ztpmlqt.c +++ b/runtime/starpu/codelets/codelet_ztpmlqt.c @@ -4,15 +4,15 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon ztpmlqt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2018-01-31 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/codelets/codelet_ztpmqrt.c b/runtime/starpu/codelets/codelet_ztpmqrt.c index 2f921000d506c73baafa5f48ab5526c880a42986..13fbfef6636e678743b7046a3ae651a2960f77e2 100644 --- a/runtime/starpu/codelets/codelet_ztpmqrt.c +++ b/runtime/starpu/codelets/codelet_ztpmqrt.c @@ -4,15 +4,15 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * * @brief Chameleon ztpmqrt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/codelets/codelet_ztpqrt.c b/runtime/starpu/codelets/codelet_ztpqrt.c index c806232a2ad3b09f0588b672cf1c59289e58c733..d6300f71ef49a9fe4a12ed23ec92a5045934f830 100644 --- a/runtime/starpu/codelets/codelet_ztpqrt.c +++ b/runtime/starpu/codelets/codelet_ztpqrt.c @@ -4,16 +4,16 @@ * * @copyright 2009-2016 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztpqrt StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge - * @date 2016-12-16 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/codelets/codelet_ztradd.c b/runtime/starpu/codelets/codelet_ztradd.c index d7799dc408dddac73b544e95cfcb2e4ef6abb158..d23ce80ebf8e278f1e9b0244af475116c50138f0 100644 --- a/runtime/starpu/codelets/codelet_ztradd.c +++ b/runtime/starpu/codelets/codelet_ztradd.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2015-11-03 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztrasm.c b/runtime/starpu/codelets/codelet_ztrasm.c index 1062237b4e9055a189b3bfd23e04719887c506e2..d650d197395ae267693e8f869c54bec55e2a773a 100644 --- a/runtime/starpu/codelets/codelet_ztrasm.c +++ b/runtime/starpu/codelets/codelet_ztrasm.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrasm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztrmm.c b/runtime/starpu/codelets/codelet_ztrmm.c index 9ae9cdf796356e5b5438746d825dda5bd7a765a3..92eb37b92890f5a69339ae8d443bf29e903e1ec8 100644 --- a/runtime/starpu/codelets/codelet_ztrmm.c +++ b/runtime/starpu/codelets/codelet_ztrmm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztrsm.c b/runtime/starpu/codelets/codelet_ztrsm.c index 6155433fac2fd0cae8e3cc324dfc00f4d6a6e7ae..250f39fbbbbcdd5363c91e83dc1bf09ca3c97117 100644 --- a/runtime/starpu/codelets/codelet_ztrsm.c +++ b/runtime/starpu/codelets/codelet_ztrsm.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztrssq.c b/runtime/starpu/codelets/codelet_ztrssq.c index 2ce632d23adb39bdabca34e50b3bd0151141a9b1..b92c02f70e37271869e96619bb25f342579f1ccf 100644 --- a/runtime/starpu/codelets/codelet_ztrssq.c +++ b/runtime/starpu/codelets/codelet_ztrssq.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrssq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.6.0 for CHAMELEON 0.9.2 * @author Mathieu Faverge - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztrtri.c b/runtime/starpu/codelets/codelet_ztrtri.c index aac4c7a04230b603c5a53d2feb7705f56a4a9a32..4c891806ce5070341a21f4cc8d8c71bed8e263b6 100644 --- a/runtime/starpu/codelets/codelet_ztrtri.c +++ b/runtime/starpu/codelets/codelet_ztrtri.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Julien Langou @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztsmlq_hetra1.c b/runtime/starpu/codelets/codelet_ztsmlq_hetra1.c index bca185baada20eb253a5029a7b61ab53b0e46e4c..d90d7742fd3f8b12a64260aea63b99def65a309c 100644 --- a/runtime/starpu/codelets/codelet_ztsmlq_hetra1.c +++ b/runtime/starpu/codelets/codelet_ztsmlq_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmlq_hetra1 StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Azzam Haidar * @author Lucas Barros de Assis - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztsmqr_hetra1.c b/runtime/starpu/codelets/codelet_ztsmqr_hetra1.c index e6e2ff53afcfb9e97fdf6843830d24d758534128..04adf4260521c5172818d7637a53bbbc1d133459 100644 --- a/runtime/starpu/codelets/codelet_ztsmqr_hetra1.c +++ b/runtime/starpu/codelets/codelet_ztsmqr_hetra1.c @@ -4,19 +4,19 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztsmqr_hetra1 StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @author Hatem Ltaief * @author Mathieu Faverge * @author Azzam Haidar * @author Lucas Barros de Assis - * @date 2016-12-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_ztstrf.c b/runtime/starpu/codelets/codelet_ztstrf.c index e8115be4f146e757539dadd79cbb34f1089e813d..1caab2a068db71654e4fc48e3af5cde4e24bc687 100644 --- a/runtime/starpu/codelets/codelet_ztstrf.c +++ b/runtime/starpu/codelets/codelet_ztstrf.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztstrf StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zunmlq.c b/runtime/starpu/codelets/codelet_zunmlq.c index 4769f790b7c06f944da115a9d218c1783861aa76..7ae725bdd087d3c31ca049614b675fbb62d14823 100644 --- a/runtime/starpu/codelets/codelet_zunmlq.c +++ b/runtime/starpu/codelets/codelet_zunmlq.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -21,7 +21,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/codelets/codelet_zunmqr.c b/runtime/starpu/codelets/codelet_zunmqr.c index dafd7fbe29095308f77c78675bff57e2402a4086..8ea66722b935b2ccd365ac219842b448687c4282 100644 --- a/runtime/starpu/codelets/codelet_zunmqr.c +++ b/runtime/starpu/codelets/codelet_zunmqr.c @@ -4,14 +4,14 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr StarPU codelet * - * @version 0.9.2 + * @version 1.0.0 * @comment This file has been automatically generated * from Plasma 2.5.0 for CHAMELEON 0.9.2 * @author Hatem Ltaief @@ -20,7 +20,7 @@ * @author Emmanuel Agullo * @author Cedric Castagnede * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/control/runtime_async.c b/runtime/starpu/control/runtime_async.c index 91ed1f32082916710e5f1821e0b34ff9fb227d42..ef2dbcc8b102751253f640ed509ea0a5678cd719 100644 --- a/runtime/starpu/control/runtime_async.c +++ b/runtime/starpu/control/runtime_async.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU asynchronous routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/starpu/control/runtime_context.c b/runtime/starpu/control/runtime_context.c index 002be36104b8f3bb59ab7012bf31e35a4336716d..f44ae20438faee407fb7b061c03574ce28694985 100644 --- a/runtime/starpu/control/runtime_context.c +++ b/runtime/starpu/control/runtime_context.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU context routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/starpu/control/runtime_control.c b/runtime/starpu/control/runtime_control.c index 6ee39b52644b48dc36fc8ea4c32e205580d6fe65..5eab3b78239b3828733c176d8de4dfded9f5cc38 100644 --- a/runtime/starpu/control/runtime_control.c +++ b/runtime/starpu/control/runtime_control.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU control routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Augonnet * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdio.h> diff --git a/runtime/starpu/control/runtime_descriptor.c b/runtime/starpu/control/runtime_descriptor.c index b5e5bfebbc84d974a6676dbb34e3f8511665bc86..8402ec55b4d1fe7610092916f550e97aa99cc631 100644 --- a/runtime/starpu/control/runtime_descriptor.c +++ b/runtime/starpu/control/runtime_descriptor.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU descriptor routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <stdlib.h> diff --git a/runtime/starpu/control/runtime_options.c b/runtime/starpu/control/runtime_options.c index 225112b40c6beec0dedfb55e34064fcb28a7183d..2a11e817305a740a022c524ac2d6138c8329f894 100644 --- a/runtime/starpu/control/runtime_options.c +++ b/runtime/starpu/control/runtime_options.c @@ -11,11 +11,11 @@ * * @brief Chameleon StarPU options routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-01-07 * */ #include <stdio.h> diff --git a/runtime/starpu/control/runtime_profiling.c b/runtime/starpu/control/runtime_profiling.c index 3eb14c21620b4ef88d88e61f5c7974fc962f5ffa..097c73a147462d097e3ebcbb2bd3a3d88d8ad379 100644 --- a/runtime/starpu/control/runtime_profiling.c +++ b/runtime/starpu/control/runtime_profiling.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU profiling routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #include <math.h> diff --git a/runtime/starpu/control/runtime_workspace.c b/runtime/starpu/control/runtime_workspace.c index 43028b5ae69f4476a7c18874455fb645299db29e..1562c3461370f9cbb8ec43b10a94ae7d7e12e9a4 100644 --- a/runtime/starpu/control/runtime_workspace.c +++ b/runtime/starpu/control/runtime_workspace.c @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU workspaces routines * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge - * @date 2015-05-22 + * @date 2020-03-03 * */ #include "chameleon_starpu.h" diff --git a/runtime/starpu/control/runtime_zlocality.c b/runtime/starpu/control/runtime_zlocality.c index 76801f2831b2850567968b1aad88fa0c313a6920..b6c9d43aad80fc6e43819bb48bf2c27a24a80ae8 100644 --- a/runtime/starpu/control/runtime_zlocality.c +++ b/runtime/starpu/control/runtime_zlocality.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU CHAMELEON_Complex64_t kernel locality management * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/control/runtime_zprofiling.c b/runtime/starpu/control/runtime_zprofiling.c index be99da3fceee4d405e86f0fc1a0ffe9f28764d55..98100576fae83c3c71c4491fe0d7204f3b28cc68 100644 --- a/runtime/starpu/control/runtime_zprofiling.c +++ b/runtime/starpu/control/runtime_zprofiling.c @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU CHAMELEON_Complex64_t kernel progiling * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * @precisions normal z -> s d c * */ diff --git a/runtime/starpu/include/cham_tile_interface.h b/runtime/starpu/include/cham_tile_interface.h index 2d449941d833940fb08d592eca447a5258c52bb0..286ba61c81cf9c826b42b45a2dcc5a62c9bb1087 100644 --- a/runtime/starpu/include/cham_tile_interface.h +++ b/runtime/starpu/include/cham_tile_interface.h @@ -2,17 +2,17 @@ * * @file starpu/cham_tile_interface.h * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Header to describe the Chameleon tile interface in StarPU * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Gwenole Lucas - * @date 2019-07-23 + * @date 2020-03-03 * */ #ifndef _cham_tile_interface_h_ diff --git a/runtime/starpu/include/chameleon_starpu.h.in b/runtime/starpu/include/chameleon_starpu.h.in index fed67ec50d78da3e941a3423775683218a983b6b..5616664308237038adb68d3e9467433835032664 100644 --- a/runtime/starpu/include/chameleon_starpu.h.in +++ b/runtime/starpu/include/chameleon_starpu.h.in @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU runtime header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede * @author Florent Pruvost - * @date 2017-07-31 + * @date 2020-03-03 * */ #ifndef _chameleon_starpu_h_ diff --git a/runtime/starpu/include/runtime_codelet_profile.h b/runtime/starpu/include/runtime_codelet_profile.h index 58c4ad729a82f16910f6825634da53864c9a0c97..20d954fdd2cda5e2071f0c945aaf9de297051a7f 100644 --- a/runtime/starpu/include/runtime_codelet_profile.h +++ b/runtime/starpu/include/runtime_codelet_profile.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU codelet profiling header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #ifndef _runtime_codelet_profile_h_ diff --git a/runtime/starpu/include/runtime_codelet_z.h b/runtime/starpu/include/runtime_codelet_z.h index 3e957e69de2c13cf65bf39bd6478d8fad74d88c5..25a14085fb7579fd40f8bb1800b3029d98cf548d 100644 --- a/runtime/starpu/include/runtime_codelet_z.h +++ b/runtime/starpu/include/runtime_codelet_z.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU CHAMELEON_Complex64_t codelets header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/runtime/starpu/include/runtime_codelets.h b/runtime/starpu/include/runtime_codelets.h index 026e754c4f72b0e2cf221dcd9611773041cd3331..9b9fdc5b1569f5611c07727c421a5815c225443d 100644 --- a/runtime/starpu/include/runtime_codelets.h +++ b/runtime/starpu/include/runtime_codelets.h @@ -4,18 +4,18 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU codelets main header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #ifndef _runtime_codelets_h_ diff --git a/runtime/starpu/include/runtime_profiling.h b/runtime/starpu/include/runtime_profiling.h index c6bdc7a30959323cdc2f5aadcc58aabee864e32d..e3fdc24ee1643b0018f960c4b3391f0d95ebc155 100644 --- a/runtime/starpu/include/runtime_profiling.h +++ b/runtime/starpu/include/runtime_profiling.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU profiling and kernel locality header * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2015-05-22 + * @date 2020-03-03 * */ #ifndef _runtime_profiling_h_ diff --git a/runtime/starpu/include/runtime_workspace.h b/runtime/starpu/include/runtime_workspace.h index 548d41505eafcb8b3cf3a18d16b618b2e5dc1c7a..18f943401f45abc74b9c9fa679976ad9352ad787 100644 --- a/runtime/starpu/include/runtime_workspace.h +++ b/runtime/starpu/include/runtime_workspace.h @@ -4,16 +4,16 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon StarPU workspace header * - * @version 0.9.2 + * @version 1.0.0 * @author Cedric Augonnet - * @date 2015-05-22 + * @date 2020-03-03 * */ #ifndef _runtime_workspace_h_ diff --git a/runtime/starpu/interface/cham_tile_interface.c b/runtime/starpu/interface/cham_tile_interface.c index 93ecebfc193b4f3aa6fc23acdc3741b8d7bafb98..b1dfbcdd3e65652bee32184f019bb5b6a804c83d 100644 --- a/runtime/starpu/interface/cham_tile_interface.c +++ b/runtime/starpu/interface/cham_tile_interface.c @@ -2,17 +2,17 @@ * * @file starpu/cham_tile_interface.c * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon tile interface for StarPU * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Gwenole Lucas - * @date 2019-07-23 + * @date 2020-03-03 * */ #include "chameleon_starpu.h" diff --git a/simucore/CMakeLists.txt b/simucore/CMakeLists.txt index 103fb86a68d7c5155623e2085d2a0afb2924de9a..082edcbd3e4b4366aad53a0b04777731425c7f90 100755 --- a/simucore/CMakeLists.txt +++ b/simucore/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,8 +17,8 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 -# @date 2014-11-16 +# @version 1.0.0 +# @date 2020-03-03 # ### diff --git a/testing/CMakeLists.txt b/testing/CMakeLists.txt index 3fb42f5da48ec26bc6ce3b72fad1817fd45c7649..67c4a29a9ac563d27fa7b37c63ac7347ddfc9783 100644 --- a/testing/CMakeLists.txt +++ b/testing/CMakeLists.txt @@ -4,7 +4,7 @@ # # @copyright 2009-2014 The University of Tennessee and The University of # Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # ### @@ -17,26 +17,20 @@ # Univ. of California Berkeley, # Univ. of Colorado Denver. # -# @version 0.9.2 +# @version 1.0.0 # @author Cedric Castagnede # @author Emmanuel Agullo # @author Mathieu Faverge -# @date 2014-11-16 +# @author Lucas Barros de Assis +# @date 2020-03-03 # ### -if (CHAMELEON_SIMULATION) - message(ERROR "testing directory should not be included when simulation is enabled") -endif() - -# Check for subdirectories -# ------------------------ -#add_subdirectory(lin) # Generate chameleon auxiliary testing sources for all possible precisions # -------------------------------------------------------------------- set(TESTING_HDRS_GENERATED "") set(ZHDR - testing_zauxiliary.h + testing_zcheck.h ) precisions_rules_py(TESTING_HDRS_GENERATED "${ZHDR}" @@ -48,54 +42,60 @@ set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};testing_include" CAC # Generate chameleon testing sources for all possible precisions # ---------------------------------------------------------- set(ZSRC - testing_zauxiliary.c - ################## - # BLAS 3 - ################## - testing_zgemm.c - testing_zhemm.c - testing_zher2k.c - testing_zherk.c - testing_zpemv.c - testing_zsymm.c - testing_zsyr2k.c - testing_zsyrk.c - testing_ztrmm.c - testing_ztrsm.c - ################## - # LAPACK - ################## - testing_zgels.c - testing_zgels_hqr.c - testing_zgels_systolic.c - #testing_zgesv.c - testing_zgesv_incpiv.c - #testing_zgetri.c - testing_zlange.c - testing_zposv.c - testing_zpotri.c - ################## - # MIXED PRECISION - ################## - #testing_zcgels.c - #testing_zcgesv.c - #testing_zcposv.c - #testing_zcungesv.c - ################## - # OTHERS - ################## - testing_zgeadd.c - #testing_zgecfi.c - testing_zgesvd.c - #testing_zgetmi.c - #testing_zheev.c - testing_zheevd.c - #testing_zhegst.c - #testing_zhegv.c - #testing_zhegvd.c - testing_zgeqrf_qdwh.c - testing_dgram.c - ) + chameleon_ztesting.c + testing_zcheck.c + ################## + # LAPACK + ################## + #testing_zlaset.c + testing_zlacpy.c + testing_zlange.c + testing_zlanhe.c + testing_zlansy.c + testing_zlantr.c + testing_zgeadd.c + testing_ztradd.c + testing_zlascal.c + testing_zgemm.c + testing_zhemm.c + testing_zherk.c + testing_zher2k.c + testing_zsymm.c + testing_zsyrk.c + testing_zsyr2k.c + testing_ztrmm.c + testing_ztrsm.c + testing_zpotrf.c + testing_zpotrs.c + testing_zposv.c + testing_ztrtri.c + testing_zlauum.c + testing_zpotri.c + testing_zsytrf.c + testing_zsytrs.c + testing_zsysv.c + testing_zgetrf.c + testing_zgetrs.c + testing_zgesv.c + testing_zgeqrf.c + testing_zungqr.c + testing_zunmqr.c + testing_zgelqf.c + testing_zunglq.c + testing_zunmlq.c + # testing_zgeqrs.c + # testing_zgelqs.c + testing_zgels.c + testing_zgeqrf_hqr.c + testing_zungqr_hqr.c + testing_zunmqr_hqr.c + testing_zgelqf_hqr.c + testing_zunglq_hqr.c + testing_zunmlq_hqr.c + # testing_zgeqrs_hqr.c + # testing_zgelqs_hqr.c + testing_zgels_hqr.c + ) # Add include and link directories # -------------------------------- @@ -113,21 +113,31 @@ list(APPEND libs_for_tests chameleon) # ----------------------------------------------- foreach(_precision ${CHAMELEON_PRECISION} ) - precisions_rules_py(${_precision}SRC_GENERATED "${ZSRC}" - PRECISIONS "${_precision}" ) + precisions_rules_py(${_precision}SRC_GENERATED "${ZSRC}" + PRECISIONS "${_precision}" ) - add_executable(${_precision}testing ${${_precision}SRC_GENERATED}) - add_dependencies(${_precision}testing - chameleon_include - coreblas_include - control_include - testing_include - ) - set_property(TARGET ${_precision}testing PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(${_precision}testing ${libs_for_tests}) + set( __target_name chameleon_${_precision}testing ) + add_executable( ${__target_name} + ${${_precision}SRC_GENERATED} + values.c + run_list.c + parameters.c + ) + add_dependencies(${__target_name} + chameleon_include + control_include + testing_include + ) +if(NOT CHAMELEON_SIMULATION) + add_dependencies(${__target_name} + coreblas_include + ) +endif(NOT CHAMELEON_SIMULATION) + set_property(TARGET ${__target_name} PROPERTY LINKER_LANGUAGE Fortran) + target_link_libraries(${__target_name} ${libs_for_tests}) - install(TARGETS ${_precision}testing - DESTINATION bin/testing) + install(TARGETS ${__target_name} + DESTINATION bin/ ) endforeach() @@ -135,24 +145,16 @@ endforeach() # --------------------------- set(TESTING_SRCS) foreach(_precision ${CHAMELEON_PRECISION}) - list(APPEND TESTING_SRCS ${${_precision}SRC_GENERATED}) + list(APPEND TESTING_SRCS ${${_precision}SRC_GENERATED}) endforeach() add_custom_target(testing_sources ALL SOURCES ${TESTING_SRCS}) set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};testing_sources" CACHE INTERNAL "List of targets of sources") -# Copy python scripts to use test drivers -# --------------------------------------- -# Copy launcher -add_custom_target(testing_launcher ALL - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/chameleon_testing.py - ${CMAKE_CURRENT_BINARY_DIR}/chameleon_testing.py) - -# install file -install(FILES ${CMAKE_CURRENT_BINARY_DIR}/chameleon_testing.py - DESTINATION bin/testing ) - #-------- Tests --------- -#include(CTestLists.cmake) +include(CTestLists.cmake) + +# copy input files +file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/input DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) ### ### END CMakeLists.txt diff --git a/testing/CTestLists.cmake b/testing/CTestLists.cmake index a5cbc1710b27393d7ff3d7b8e691b7c8a8a48429..9e95012c96a6b1d19dd1e7406f93112092b351a1 100644 --- a/testing/CTestLists.cmake +++ b/testing/CTestLists.cmake @@ -1,76 +1,78 @@ # # Check testing/ # - -set(TEST_CMD_shm testing 4 0 19 7 ) -set(TEST_CMD_shmgpu testing 4 1 19 7 ) -# set(TEST_CMD_mpi testing 4 0 19 7 ) -# set(TEST_CMD_mpigpu testing 4 1 19 7 ) - -set( TEST_CATEGORIES shm ) +set(NP 2) # Amount of MPI processes +set(THREADS 2) # Amount of threads +set(N_GPUS 0) # Amount of graphic cards +set(TEST_CATEGORIES shm) +if (CHAMELEON_USE_MPI AND MPI_C_FOUND) + set( TEST_CATEGORIES ${TEST_CATEGORIES} mpi ) +endif() if (CHAMELEON_USE_CUDA AND CUDA_FOUND) - set( TEST_CATEGORIES ${TEST_CATEGORIES} shmgpu ) + set(N_GPUS 0 1) endif() -foreach(cat ${TEST_CATEGORIES}) - foreach(prec ${RP_CHAMELEON_PRECISIONS}) +foreach(prec ${RP_CHAMELEON_PRECISIONS}) + set (CMD ./chameleon_${prec}testing) - string(TOUPPER ${prec} PREC) + # + # Create the list of test based on precision and runtime + # + set( TESTS lacpy lange lantr lansy ) + if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) + set( TESTS ${TESTS} lanhe ) + endif() + set( TESTS ${TESTS} + geadd tradd lascal + gemm symm syrk syr2k trmm trsm ) + if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) + set( TESTS ${TESTS} + hemm herk her2k ) + endif() + set( TESTS ${TESTS} + potrf potrs posv trtri lauum ) + if ( NOT CHAMELEON_SCHED_PARSEC ) + set( TESTS ${TESTS} potri ) + endif() + if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) + set( TESTS ${TESTS} + sytrf sytrs sysv ) + endif() + set( TESTS ${TESTS} + getrf getrs gesv + geqrf gelqf + geqrf_hqr gelqf_hqr) + if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) + set( TESTS ${TESTS} + ungqr unglq unmqr unmlq + ungqr_hqr unglq_hqr unmqr_hqr unmlq_hqr) + else() + set( TESTS ${TESTS} + orgqr orglq ormqr ormlq + orgqr_hqr orglq_hqr ormqr_hqr ormlq_hqr) + endif() + set( TESTS ${TESTS} + #geqrs gelqs + #geqrs_hqr gelqs_hqr + gels + gels_hqr ) - if (CHAMELEON_PREC_${PREC}) - add_test(test_${cat}_${prec}lange ./${prec}${TEST_CMD_${cat}} LANGE 117 213 232 ) - add_test(test_${cat}_${prec}gemm ./${prec}${TEST_CMD_${cat}} GEADD 1.7 -2.3 117 213 215 220 ) - add_test(test_${cat}_${prec}gemm ./${prec}${TEST_CMD_${cat}} GEMM 1.7 -2.3 117 213 97 215 220 232) - add_test(test_${cat}_${prec}trsm ./${prec}${TEST_CMD_${cat}} TRSM -2.3 117 213 215 220 ) - add_test(test_${cat}_${prec}trmm ./${prec}${TEST_CMD_${cat}} TRMM -2.3 117 213 215 220 ) - add_test(test_${cat}_${prec}symm ./${prec}${TEST_CMD_${cat}} SYMM 1.7 -2.3 117 213 215 220 232) - add_test(test_${cat}_${prec}syrk ./${prec}${TEST_CMD_${cat}} SYRK 1.7 -2.3 117 213 215 220 ) - add_test(test_${cat}_${prec}syr2k ./${prec}${TEST_CMD_${cat}} SYR2K 1.7 -2.3 117 213 215 220 232) + foreach(cat ${TEST_CATEGORIES}) + foreach(gpus ${N_GPUS}) - if ( ${prec} STREQUAL c OR ${prec} STREQUAL z ) - add_test(test_${cat}_${prec}hemm ./${prec}${TEST_CMD_${cat}} HEMM 1.7 -2.3 117 213 215 220 232) - add_test(test_${cat}_${prec}herk ./${prec}${TEST_CMD_${cat}} HERK 1.7 -2.3 117 213 215 220 ) - add_test(test_${cat}_${prec}her2k ./${prec}${TEST_CMD_${cat}} HER2K 1.7 -2.3 117 213 215 220 232) + if (${gpus} EQUAL 1) + set(cat ${cat}_gpu) endif() - add_test(test_${cat}_${prec}posv ./${prec}${TEST_CMD_${cat}} POSV 117 155 25 143) - if ( NOT CHAMELEON_SCHED_PARSEC ) - add_test(test_${cat}_${prec}potri ./${prec}${TEST_CMD_${cat}} POTRI 117 155 ) + if (${cat} STREQUAL "mpi") + set (PREFIX mpiexec --bind-to none -n ${NP}) + else() + set (PREFIX "") endif() - add_test(test_${cat}_${prec}gels_qr ./${prec}${TEST_CMD_${cat}} GELS 0 233 117 255 25 242 ) - add_test(test_${cat}_${prec}gels_hqr ./${prec}${TEST_CMD_${cat}} GELS 1 233 117 255 25 242 3) - add_test(test_${cat}_${prec}gels_lq ./${prec}${TEST_CMD_${cat}} GELS 0 117 233 155 25 242 ) - add_test(test_${cat}_${prec}gels_hlq ./${prec}${TEST_CMD_${cat}} GELS 1 117 233 155 25 242 3) - add_test(test_${cat}_${prec}gesv_incpiv ./${prec}${TEST_CMD_${cat}} GESV_INCPIV 117 155 25 242) - - add_test(test_${cat}_${prec}gels_hqr_greedy ./${prec}${TEST_CMD_${cat}} GELS_HQR 233 117 255 25 242 2 -1 1 -1 0) - add_test(test_${cat}_${prec}gels_hqr_fibonacci ./${prec}${TEST_CMD_${cat}} GELS_HQR 233 117 255 25 242 2 -1 2 -1 0) - add_test(test_${cat}_${prec}gels_hqr_binary ./${prec}${TEST_CMD_${cat}} GELS_HQR 233 117 255 25 242 2 -1 3 -1 0) - add_test(test_${cat}_${prec}gels_hlq_greedy ./${prec}${TEST_CMD_${cat}} GELS_HQR 117 233 255 25 242 2 -1 1 -1 0) - add_test(test_${cat}_${prec}gels_hlq_fibonacci ./${prec}${TEST_CMD_${cat}} GELS_HQR 117 233 255 25 242 2 -1 2 -1 0) - add_test(test_${cat}_${prec}gels_hlq_binary ./${prec}${TEST_CMD_${cat}} GELS_HQR 117 233 255 25 242 2 -1 3 -1 0) - - add_test(test_${cat}_${prec}gels_qr_systolic ./${prec}${TEST_CMD_${cat}} GELS_SYSTOLIC 233 117 255 25 242 3 2) - add_test(test_${cat}_${prec}gels_lq_systolic ./${prec}${TEST_CMD_${cat}} GELS_SYSTOLIC 117 233 255 25 242 3 2) - endif() + foreach(_test ${TESTS}) + add_test(test_${cat}_${prec}${_test} ${PREFIX} ${CMD} -c -t ${THREADS} -g ${gpus} -P 1 -f input/${_test}.in ) + endforeach() + endforeach() endforeach() endforeach() - -#if (CHAMELEON_USE_MPI AND MPI_C_FOUND) -# set( TEST_CATEGORIES ${TEST_CATEGORIES} mpi ) -# if (CHAMELEON_USE_CUDA AND CUDA_FOUND) -# set( TEST_CATEGORIES ${TEST_CATEGORIES} mpigpu ) -# endif() -# foreach(prec ${RP_CHAMELEON_PRECISIONS}) -# add_test(test_mpi_${prec}lange mpirun -np 4 ./${prec}testing 1 0 LANGE 600 500 600 --p=2) -# endforeach() -#endif() - -# Specific algorithms -# Gram -foreach(cat ${TEST_CATEGORIES}) - foreach(prec s;d) - add_test(test_${cat}_${prec}gram ./${prec}${TEST_CMD_${cat}} GRAM 117 213 ) - endforeach() -endforeach() \ No newline at end of file diff --git a/testing/chameleon_testing.py b/testing/chameleon_testing.py deleted file mode 100755 index 430c6cda95c003bda94a43ffa865c3777e695184..0000000000000000000000000000000000000000 --- a/testing/chameleon_testing.py +++ /dev/null @@ -1,181 +0,0 @@ -#! /usr/bin/env python -# -*- coding: utf-8 -*- - - -############################################################################### -# chameleon_testing.py [nbcores] -# nbcores is a optional argument to give the number of cores to run the testing -# Example: -# ./chameleon_testing.py -# No argument, so will run on half of the core if the machine has more than 2 cores -# ./chameleon_testing.py nbcores -# Will run on nbcores -############################################################################### - -from subprocess import Popen, STDOUT, PIPE -import os, sys, math -import getopt - -# Linux Unix and MacOS: -if hasattr(os, "sysconf"): - if os.sysconf_names.has_key("SC_NPROCESSORS_ONLN"): - ncpus_av = os.sysconf("SC_NPROCESSORS_ONLN") -# Windows: -if os.environ.has_key("NUMBER_OF_PROCESSORS"): - ncpus_av = int(os.environ["NUMBER_OF_PROCESSORS"]); - -# we are going to run on half of the cores by default if we have more than 2 cores -if (ncpus_av > 2): - ncpus=int(math.floor(ncpus_av/2)) -else: - ncpus=ncpus_av - -try: - opts, args = getopt.getopt(sys.argv[1:], "hnc:g:", - ["help", "cores=", "ngpus="]) - -except getopt.error, msg: - print msg - print "for help use --help" - sys.exit(2) - -# process options -ngpus=0; -execution=1; - -for o, a in opts: - if o in ("-h", "--help"): - print sys.argv[0]+" [-h|--help] [-c n|--cores=n] [-g m|--ngpus=m]" - print " -c Fix the number of cores" - print " -g Fix the number of gpus" - print " -n Print the commands only" - sys.exit(0) - else: - if o in ( '-c', '--ncores' ): - ncpus = a - elif o in ( '-g' , '--ngpus' ): - ngpus = a - elif o in ( '-n' , '--noexec' ): - execution=0 - -# Add current directory to the path for subshells of this shell -# Allows the popen to find local files in both windows and unixes -os.environ["PATH"] = os.environ["PATH"]+":." - -# Define a function to open the executable (different filenames on unix and Windows) -def local_popen( f, cmdline ): - if os.name != 'nt': - cmdline="./" + cmdline - - if execution==0: - print cmdline - else: - p=Popen( cmdline, shell=True, stdout=PIPE, stderr=STDOUT ) - - r=p.poll() - while r == None: - r=p.poll() - pipe=p.stdout - - if r != 0: - print "---- TESTING " + cmdline.split()[3] + "... FAILED(" + str(p.returncode) +") !" - for line in pipe.readlines(): - f.write(str(line)) - else: - found=0 - for line in pipe.readlines(): - f.write(str(line)) - if "TESTING" in line : - found = 1 - print line, - if found == 0: - print cmdline.split()[0] + " " + cmdline.split()[3] + ": FAILED(Unexpected error)" - - f.flush(); - return 0 - - -# If filename cannot be opened, send output to sys.stderr -filename = "testing_results.txt" -try: - f = open(filename, 'w') -except IOError: - f = sys.stdout - -print " " -print "---------------- Testing CHAMELEON Routines ----------------" -print " " -print "-- Number of cores available =", ncpus_av -print "-- Number of cores used for testing =", ncpus -print "-- Number of gpus used for testing =", ngpus -print "-- Detailed results are stored in", filename - -dtypes = ( -("s", "d", "c", "z"), -("Single", "Double", "Complex", "Double Complex"), -) - -for dtype in range(4): - letter = dtypes[0][dtype] - name = dtypes[1][dtype] - -# print " " -# print "--------------------- In Place Transformation -------------------" -# print " " - sys.stdout.flush() - - cmdbase="%stesting " % letter + str(ncpus) + " " + str(ngpus) - -# test01=local_popen(f, cmdbase + " GECFI" + " 623 531 123 145 136 134") -# test02=local_popen(f, cmdbase + " GETMI" + " 623 531 123 145") - - print " " - print "------------------------- %s ------------------------" % name - print " " - sys.stdout.flush() - - test0 = local_popen(f, cmdbase + " LANGE" + " 914 510 950") - test1 = local_popen(f, cmdbase + " GEMM" + " 1.0 -2.0 623 531 550 650 625 700") - test2 = local_popen(f, cmdbase + " TRSM" + " -2.0 623 531 650 625") - test3 = local_popen(f, cmdbase + " TRMM" + " -2.0 623 531 650 625") - test4 = local_popen(f, cmdbase + " SYMM" + " 1.0 -2.0 623 531 650 625 700") - test5 = local_popen(f, cmdbase + " SYRK" + " 1.0 -2.0 623 531 650 625") - test6 = local_popen(f, cmdbase + " SYR2K" + " 1.0 -2.0 623 531 650 625 700") - - if letter in ( "c", "z" ) : - test101 = local_popen(f, "%stesting " % letter + str(ncpus) + " " + str(ngpus) + " HEMM" + " 1.0 -2.0 623 531 650 625 623") - test102 = local_popen(f, "%stesting " % letter + str(ncpus) + " " + str(ngpus) + " HERK" + " 1.0 -2.0 623 531 650 625") - test102 = local_popen(f, "%stesting " % letter + str(ncpus) + " " + str(ngpus) + " HER2K"+ " 1.0 -2.0 623 531 650 625 700") - - test20 = local_popen(f, cmdbase + " POSV" + " 531 623 25 700") - test21 = local_popen(f, cmdbase + " POTRI" + " 531 623") - test22 = local_popen(f, cmdbase + " GELS" + " 0 800 400 825 25 810") - test23 = local_popen(f, cmdbase + " GELS" + " 1 800 400 825 25 810 4") - test24 = local_popen(f, cmdbase + " GELS" + " 0 400 800 825 25 810") - test25 = local_popen(f, cmdbase + " GELS" + " 1 400 800 825 25 810 4") - test26 = local_popen(f, cmdbase + " GESV_INCPIV" + " 800 825 25 810") -# test26 = local_popen(f, cmdbase + " GESV" + " 800 825 25 810") -# test27 = local_popen(f, cmdbase + " GETRI" + " 800 825") -# test28 = local_popen(f, cmdbase + " GESVD" + " 0 825 800 855") -# test29 = local_popen(f, cmdbase + " GESVD" + " 0 800 825 810") -# test30 = local_popen(f, cmdbase + " HEGV" + " 800 825 810") -# test31 = local_popen(f, cmdbase + " HEEV" + " 800 825") -# test32 = local_popen(f, cmdbase + " HEGST" + " 800 825 810") - sys.stdout.flush() - -#print " " -#print "--------------------- Mixed Precision -------------------" -#print " " - -#for substr in ( ("z", "C"), ("d", "S") ): -# cmdbase="%stesting " % substr[0] + str(ncpus) + " " + str(ngpus) - -# test201 = local_popen(f, cmdbase + " %sGESV" % substr[1] + " 800 825 25 810") -# test202 = local_popen(f, cmdbase + " %sUNGESV" % substr[1] + " 800 825 25 810") -# test203 = local_popen(f, cmdbase + " %sPOSV" % substr[1] + " 800 825 25 810") -# sys.stdout.flush() - - - -# This may close the sys.stdout stream, so make it the last statement -f.close() diff --git a/new-testing/testing_zauxiliary.c b/testing/chameleon_ztesting.c similarity index 99% rename from new-testing/testing_zauxiliary.c rename to testing/chameleon_ztesting.c index e46a7a5422ac0bdacbdc78f144c95b2748730f8e..93fc4472e77e949e4610d5d3f575f0c1470bb8f2 100644 --- a/new-testing/testing_zauxiliary.c +++ b/testing/chameleon_ztesting.c @@ -1,21 +1,21 @@ /** * - * @file testing_zauxiliary.c + * @file chameleon_ztesting.c * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings routines * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cédric Castagnède * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ diff --git a/new-testing/flops.h b/testing/flops.h similarity index 99% rename from new-testing/flops.h rename to testing/flops.h index ce0d8c48faa68cd986b8af105349e2328039da22..b6abe0c68d6abcc607758fe685e102d4ae499b6e 100644 --- a/new-testing/flops.h +++ b/testing/flops.h @@ -4,17 +4,17 @@ * * @copyright 2009-2014 The University of Tennessee and The University of * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2012-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * File provided by Univ. of Tennessee, * - * @version 0.9.2 + * @version 1.0.0 * @author Mathieu Faverge * @author Cedric Castagnede - * @date 2014-11-16 + * @date 2020-03-03 * */ /* diff --git a/new-testing/input/geadd.in b/testing/input/geadd.in similarity index 100% rename from new-testing/input/geadd.in rename to testing/input/geadd.in diff --git a/new-testing/input/gelqf.in b/testing/input/gelqf.in similarity index 100% rename from new-testing/input/gelqf.in rename to testing/input/gelqf.in diff --git a/new-testing/input/gelqf_hqr.in b/testing/input/gelqf_hqr.in similarity index 100% rename from new-testing/input/gelqf_hqr.in rename to testing/input/gelqf_hqr.in diff --git a/new-testing/input/gelqs.in b/testing/input/gelqs.in similarity index 100% rename from new-testing/input/gelqs.in rename to testing/input/gelqs.in diff --git a/new-testing/input/gels.in b/testing/input/gels.in similarity index 100% rename from new-testing/input/gels.in rename to testing/input/gels.in diff --git a/new-testing/input/gels_hqr.in b/testing/input/gels_hqr.in similarity index 100% rename from new-testing/input/gels_hqr.in rename to testing/input/gels_hqr.in diff --git a/new-testing/input/gemm.in b/testing/input/gemm.in similarity index 100% rename from new-testing/input/gemm.in rename to testing/input/gemm.in diff --git a/new-testing/input/geqrf.in b/testing/input/geqrf.in similarity index 100% rename from new-testing/input/geqrf.in rename to testing/input/geqrf.in diff --git a/new-testing/input/geqrf_hqr.in b/testing/input/geqrf_hqr.in similarity index 100% rename from new-testing/input/geqrf_hqr.in rename to testing/input/geqrf_hqr.in diff --git a/new-testing/input/geqrs.in b/testing/input/geqrs.in similarity index 100% rename from new-testing/input/geqrs.in rename to testing/input/geqrs.in diff --git a/new-testing/input/gesv.in b/testing/input/gesv.in similarity index 100% rename from new-testing/input/gesv.in rename to testing/input/gesv.in diff --git a/new-testing/input/getrf.in b/testing/input/getrf.in similarity index 100% rename from new-testing/input/getrf.in rename to testing/input/getrf.in diff --git a/new-testing/input/getrs.in b/testing/input/getrs.in similarity index 100% rename from new-testing/input/getrs.in rename to testing/input/getrs.in diff --git a/new-testing/input/hemm.in b/testing/input/hemm.in similarity index 100% rename from new-testing/input/hemm.in rename to testing/input/hemm.in diff --git a/new-testing/input/her2k.in b/testing/input/her2k.in similarity index 100% rename from new-testing/input/her2k.in rename to testing/input/her2k.in diff --git a/new-testing/input/herk.in b/testing/input/herk.in similarity index 100% rename from new-testing/input/herk.in rename to testing/input/herk.in diff --git a/new-testing/input/lacpy.in b/testing/input/lacpy.in similarity index 100% rename from new-testing/input/lacpy.in rename to testing/input/lacpy.in diff --git a/new-testing/input/lange.in b/testing/input/lange.in similarity index 100% rename from new-testing/input/lange.in rename to testing/input/lange.in diff --git a/new-testing/input/lanhe.in b/testing/input/lanhe.in similarity index 100% rename from new-testing/input/lanhe.in rename to testing/input/lanhe.in diff --git a/new-testing/input/lansy.in b/testing/input/lansy.in similarity index 100% rename from new-testing/input/lansy.in rename to testing/input/lansy.in diff --git a/new-testing/input/lantr.in b/testing/input/lantr.in similarity index 100% rename from new-testing/input/lantr.in rename to testing/input/lantr.in diff --git a/new-testing/input/lascal.in b/testing/input/lascal.in similarity index 100% rename from new-testing/input/lascal.in rename to testing/input/lascal.in diff --git a/new-testing/input/lauum.in b/testing/input/lauum.in similarity index 100% rename from new-testing/input/lauum.in rename to testing/input/lauum.in diff --git a/new-testing/input/ongqr.in b/testing/input/ongqr.in similarity index 100% rename from new-testing/input/ongqr.in rename to testing/input/ongqr.in diff --git a/new-testing/input/orglq.in b/testing/input/orglq.in similarity index 100% rename from new-testing/input/orglq.in rename to testing/input/orglq.in diff --git a/new-testing/input/orglq_hqr.in b/testing/input/orglq_hqr.in similarity index 100% rename from new-testing/input/orglq_hqr.in rename to testing/input/orglq_hqr.in diff --git a/new-testing/input/orgqr.in b/testing/input/orgqr.in similarity index 100% rename from new-testing/input/orgqr.in rename to testing/input/orgqr.in diff --git a/new-testing/input/orgqr_hqr.in b/testing/input/orgqr_hqr.in similarity index 100% rename from new-testing/input/orgqr_hqr.in rename to testing/input/orgqr_hqr.in diff --git a/new-testing/input/ormlq.in b/testing/input/ormlq.in similarity index 100% rename from new-testing/input/ormlq.in rename to testing/input/ormlq.in diff --git a/new-testing/input/ormlq_hqr.in b/testing/input/ormlq_hqr.in similarity index 100% rename from new-testing/input/ormlq_hqr.in rename to testing/input/ormlq_hqr.in diff --git a/new-testing/input/ormqr.in b/testing/input/ormqr.in similarity index 100% rename from new-testing/input/ormqr.in rename to testing/input/ormqr.in diff --git a/new-testing/input/ormqr_hqr.in b/testing/input/ormqr_hqr.in similarity index 100% rename from new-testing/input/ormqr_hqr.in rename to testing/input/ormqr_hqr.in diff --git a/new-testing/input/posv.in b/testing/input/posv.in similarity index 100% rename from new-testing/input/posv.in rename to testing/input/posv.in diff --git a/new-testing/input/potrf.in b/testing/input/potrf.in similarity index 100% rename from new-testing/input/potrf.in rename to testing/input/potrf.in diff --git a/new-testing/input/potri.in b/testing/input/potri.in similarity index 100% rename from new-testing/input/potri.in rename to testing/input/potri.in diff --git a/new-testing/input/potrs.in b/testing/input/potrs.in similarity index 100% rename from new-testing/input/potrs.in rename to testing/input/potrs.in diff --git a/new-testing/input/symm.in b/testing/input/symm.in similarity index 100% rename from new-testing/input/symm.in rename to testing/input/symm.in diff --git a/new-testing/input/syr2k.in b/testing/input/syr2k.in similarity index 100% rename from new-testing/input/syr2k.in rename to testing/input/syr2k.in diff --git a/new-testing/input/syrk.in b/testing/input/syrk.in similarity index 100% rename from new-testing/input/syrk.in rename to testing/input/syrk.in diff --git a/new-testing/input/sysv.in b/testing/input/sysv.in similarity index 100% rename from new-testing/input/sysv.in rename to testing/input/sysv.in diff --git a/new-testing/input/sytrf.in b/testing/input/sytrf.in similarity index 100% rename from new-testing/input/sytrf.in rename to testing/input/sytrf.in diff --git a/new-testing/input/sytrs.in b/testing/input/sytrs.in similarity index 100% rename from new-testing/input/sytrs.in rename to testing/input/sytrs.in diff --git a/new-testing/input/tradd.in b/testing/input/tradd.in similarity index 100% rename from new-testing/input/tradd.in rename to testing/input/tradd.in diff --git a/new-testing/input/trmm.in b/testing/input/trmm.in similarity index 100% rename from new-testing/input/trmm.in rename to testing/input/trmm.in diff --git a/new-testing/input/trsm.in b/testing/input/trsm.in similarity index 100% rename from new-testing/input/trsm.in rename to testing/input/trsm.in diff --git a/new-testing/input/trtri.in b/testing/input/trtri.in similarity index 100% rename from new-testing/input/trtri.in rename to testing/input/trtri.in diff --git a/new-testing/input/unglq.in b/testing/input/unglq.in similarity index 100% rename from new-testing/input/unglq.in rename to testing/input/unglq.in diff --git a/new-testing/input/unglq_hqr.in b/testing/input/unglq_hqr.in similarity index 100% rename from new-testing/input/unglq_hqr.in rename to testing/input/unglq_hqr.in diff --git a/new-testing/input/ungqr.in b/testing/input/ungqr.in similarity index 100% rename from new-testing/input/ungqr.in rename to testing/input/ungqr.in diff --git a/new-testing/input/ungqr_hqr.in b/testing/input/ungqr_hqr.in similarity index 100% rename from new-testing/input/ungqr_hqr.in rename to testing/input/ungqr_hqr.in diff --git a/new-testing/input/unmlq.in b/testing/input/unmlq.in similarity index 100% rename from new-testing/input/unmlq.in rename to testing/input/unmlq.in diff --git a/new-testing/input/unmlq_hqr.in b/testing/input/unmlq_hqr.in similarity index 100% rename from new-testing/input/unmlq_hqr.in rename to testing/input/unmlq_hqr.in diff --git a/new-testing/input/unmqr.in b/testing/input/unmqr.in similarity index 100% rename from new-testing/input/unmqr.in rename to testing/input/unmqr.in diff --git a/new-testing/input/unmqr_hqr.in b/testing/input/unmqr_hqr.in similarity index 100% rename from new-testing/input/unmqr_hqr.in rename to testing/input/unmqr_hqr.in diff --git a/testing/lin/CMakeLists.txt b/testing/lin/CMakeLists.txt deleted file mode 100644 index dcce2cdda87aa309ac0d9dc803e26cd54ab433e5..0000000000000000000000000000000000000000 --- a/testing/lin/CMakeLists.txt +++ /dev/null @@ -1,212 +0,0 @@ -### -# -# @file CMakeLists.txt -# -# @copyright 2009-2014 The University of Tennessee and The University of -# Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, -# Univ. Bordeaux. All rights reserved. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2012-07-13 -# -### - -cmake_minimum_required(VERSION 2.8) - -# Add include and link directories -# -------------------------------- -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) -include_directories(${CMAKE_CURRENT_BINARY_DIR}) - -# list of sources files -# --------------------- -set(ALINTST - aladhd.f alaerh.f alaesm.f alahd.f alareq.f - alasum.f alasvm.f chkxer.f lsamen.f xlaenv.f xerbla.f - ) - -set(SCLNTST slaord.f) - -set(DZLNTST dlaord.f) - -set(SLINTST - schkaa.f - schkge.f serrge.f sdrvge.f - serrvx.f - sget02.f sget04.f sget06.f - schkpo.f serrpo.f sdrvpo.f - sposvx.f spotri.f sporfs.f - spot01.f spot02.f spot03.f spot05.f - sdrvls.f serrls.f - schkqr.f serrqr.f - sqrt01.f sqrt02.f sqrt03.f sqrt13.f sqrt14.f sqrt15.f sqrt16.f sqrt17.f - schklq.f serrlq.f - slqt01.f slqt02.f slqt03.f - slarhs.f slatb4.f sgennd.f - sgeequ.f slaqge.f - spoequ.f slaqsy.f spocon.f slacn2.f slatrs.f slabad.f srscl.f - slascl.f slaset.f slatms.f slartg.f slatm1.f slarnd.f slarot.f - slaror.f slagsy.f slagge.f slaran.f - slauum.f strtri.f - slauu2.f strti2.f - ) - -set(DLINTST - dchkaa.f - dchkge.f derrge.f ddrvge.f - derrvx.f - dget02.f dget04.f dget06.f - dchkpo.f derrpo.f ddrvpo.f - dposvx.f dpotri.f dporfs.f - dpot01.f dpot02.f dpot03.f dpot05.f - ddrvls.f derrls.f - dchkqr.f derrqr.f - dqrt01.f dqrt02.f dqrt03.f dqrt13.f dqrt14.f dqrt15.f dqrt16.f dqrt17.f - dchklq.f derrlq.f - dlqt01.f dlqt02.f dlqt03.f - dlarhs.f dlatb4.f dgennd.f - dgeequ.f dlaqge.f - dpoequ.f dlaqsy.f dpocon.f dlacn2.f dlatrs.f dlabad.f drscl.f - dlascl.f dlaset.f dlatms.f dlartg.f dlatm1.f dlarnd.f dlarot.f - dlaror.f dlagsy.f dlagge.f dlaran.f - dlauum.f dtrtri.f - dlauu2.f dtrti2.f - ) - -set(CLINTST - cchkaa.f - cchkge.f cerrge.f cdrvge.f - cerrvx.f - cget02.f cget04.f - cchkpo.f cerrpo.f cdrvpo.f - cposvx.f cpotri.f cporfs.f - cpot01.f cpot02.f cpot03.f cpot05.f - cdrvls.f cerrls.f - cchkqr.f cerrqr.f - cqrt01.f cqrt02.f cqrt03.f cqrt13.f cqrt14.f cqrt15.f cqrt16.f cqrt17.f - cchklq.f cerrlq.f - clqt01.f clqt02.f clqt03.f - clarhs.f clatb4.f cgennd.f - cgeequ.f claqge.f - cpoequ.f claqsy.f cpocon.f clacn2.f clatrs.f csrscl.f - clascl.f claset.f clatms.f clartg.f clatm1.f clarnd.f clarot.f clanhe.f claqhe.f - claror.f clagsy.f clagge.f - claipd.f csbmv.f - clauum.f ctrtri.f - clauu2.f ctrti2.f - cspmv.f csymv.f - sget06.f slabad.f slaran.f slarnd.f slascl.f slatm1.f scsum1.f icmax1.f - ) -set(ZLINTST - zchkaa.f - zchkge.f zerrge.f zdrvge.f - zerrvx.f - zget02.f zget04.f - zchkpo.f zerrpo.f zdrvpo.f - zposvx.f zpotri.f zporfs.f - zpot01.f zpot02.f zpot03.f zpot05.f - zdrvls.f zerrls.f - zchkqr.f zerrqr.f - zqrt01.f zqrt02.f zqrt03.f zqrt13.f zqrt14.f zqrt15.f zqrt16.f zqrt17.f - zchklq.f zerrlq.f - zlqt01.f zlqt02.f zlqt03.f - zlarhs.f zlatb4.f zgennd.f - zgeequ.f zlaqge.f - zpoequ.f zlaqsy.f zpocon.f zlacn2.f zlatrs.f zdrscl.f - zlascl.f zlaset.f zlatms.f zlartg.f zlatm1.f zlarnd.f zlarot.f zlanhe.f zlaqhe.f - zlaror.f zlagsy.f zlagge.f - zlaipd.f zsbmv.f - zlauum.f ztrtri.f - zlauu2.f ztrti2.f - zspmv.f zsymv.f - dget06.f dlabad.f dlaran.f dlarnd.f dlascl.f dlatm1.f dzsum1.f izmax1.f - ) - - -# Define what libraries we have to link with -# ------------------------------------------ -set(libs_for_tests chameleon) - -list(APPEND libs_for_tests - ${LAPACKE_LIBRARIES} - ${TMG_LIBRARIES} - ${CBLAS_LIBRARIES} - ${LAPACK_SEQ_LIBRARIES} - ${BLAS_SEQ_LIBRARIES} - ${EXTRA_LIBRARIES} - ) - -link_directories(${LAPACKE_LIBRARY_DIRS}) -link_directories(${TMG_LIBRARY_DIRS}) -link_directories(${LAPACK_LIBRARY_DIRS}) -link_directories(${CBLAS_LIBRARY_DIRS}) -link_directories(${BLAS_LIBRARY_DIRS}) - -list(APPEND libs_for_tests ${CMAKE_Fortran_FLAGS}) -list(APPEND libs_for_tests ${CMAKE_Fortran_LDFLAGS}) - - -# Define precisions to compile -# ---------------------------- -if(CHAMELEON_PREC_S) - add_executable(chameleon_xlintsts ${ALINTST} ${SLINTST} ${SCLNTST}) - set_property(TARGET chameleon_xlintsts PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(chameleon_xlintsts ${libs_for_tests}) - install(TARGETS chameleon_xlintsts - DESTINATION bin/testing/lin) -endif() - -if(CHAMELEON_PREC_S) - add_executable(chameleon_xlintstd ${ALINTST} ${DLINTST} ${DZLNTST}) - set_property(TARGET chameleon_xlintstd PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(chameleon_xlintstd ${libs_for_tests}) - install(TARGETS chameleon_xlintstd - DESTINATION bin/testing/lin) -endif() - -if(CHAMELEON_PREC_C) - add_executable(chameleon_xlintstc ${ALINTST} ${CLINTST} ${SCLNTST}) - set_property(TARGET chameleon_xlintstc PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(chameleon_xlintstc ${libs_for_tests}) - install(TARGETS chameleon_xlintstc - DESTINATION bin/testing/lin) -endif() - -if(CHAMELEON_PREC_Z) - add_executable(chameleon_xlintstz ${ALINTST} ${ZLINTST} ${DZLNTST}) - set_property(TARGET chameleon_xlintstz PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(chameleon_xlintstz ${libs_for_tests}) - install(TARGETS chameleon_xlintstz - DESTINATION bin/testing/lin) -endif() - -# Copy launcher -# ------------- -add_custom_target(lin_launcher ALL - COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/chameleon_lintesting.py - ${CMAKE_CURRENT_BINARY_DIR}/chameleon_lintesting.py) - -# Add tests (C/CPP) -# ----------------- -add_test(NAME lapack_testing - COMMAND ${PYTHON_EXECUTABLE} - ${CMAKE_CURRENT_BINARY_DIR}/chameleon_lintesting.py - ) - -### -### END CMakeLists.txt -### diff --git a/testing/lin/aladhd.f b/testing/lin/aladhd.f deleted file mode 100644 index 2a56c21d3c88379d625906e57be6b6fbc42ede89..0000000000000000000000000000000000000000 --- a/testing/lin/aladhd.f +++ /dev/null @@ -1,413 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALADHD( IOUNIT, PATH ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER IOUNIT -* .. -* -* Purpose -* ======= -* -* ALADHD prints header information for the driver routines test paths. -* -* Arguments -* ========= -* -* IOUNIT (input) INTEGER -* The unit number to which the header information should be -* printed. -* -* PATH (input) CHARACTER*3 -* The name of the path for which the header information is to -* be printed. Current paths are -* _GE: General matrices -* _GB: General band -* _GT: General Tridiagonal -* _PO: Symmetric or Hermitian positive definite -* _PS: Symmetric or Hermitian positive semi-definite -* _PP: Symmetric or Hermitian positive definite packed -* _PB: Symmetric or Hermitian positive definite band -* _PT: Symmetric or Hermitian positive definite tridiagonal -* _SY: Symmetric indefinite -* _SP: Symmetric indefinite packed -* _HE: (complex) Hermitian indefinite -* _HP: (complex) Hermitian indefinite packed -* The first character must be one of S, D, C, or Z (C or Z only -* if complex). -* -* .. Local Scalars .. - LOGICAL CORZ, SORD - CHARACTER C1, C3 - CHARACTER*2 P2 - CHARACTER*9 SYM -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. Executable Statements .. -* - IF( IOUNIT.LE.0 ) - $ RETURN - C1 = PATH( 1: 1 ) - C3 = PATH( 3: 3 ) - P2 = PATH( 2: 3 ) - SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) - CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' ) - IF( .NOT.( SORD .OR. CORZ ) ) - $ RETURN -* - IF( LSAMEN( 2, P2, 'GE' ) ) THEN -* -* GE: General dense -* - WRITE( IOUNIT, FMT = 9999 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9989 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9981 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = 9972 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN -* -* GB: General band -* - WRITE( IOUNIT, FMT = 9998 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9988 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9981 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = 9972 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN -* -* GT: General tridiagonal -* - WRITE( IOUNIT, FMT = 9997 )PATH - WRITE( IOUNIT, FMT = 9987 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9981 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PO' ) .OR. LSAMEN( 2, P2, 'PP' ) - $ .OR. LSAMEN( 2, P2, 'PS' ) ) THEN -* -* PO: Positive definite full -* PS: Positive definite full -* PP: Positive definite packed -* - IF( SORD ) THEN - SYM = 'Symmetric' - ELSE - SYM = 'Hermitian' - END IF - IF( LSAME( C3, 'O' ) ) THEN - WRITE( IOUNIT, FMT = 9996 )PATH, SYM - ELSE - WRITE( IOUNIT, FMT = 9995 )PATH, SYM - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9985 )PATH - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9975 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PB' ) ) THEN -* -* PB: Positive definite band -* - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9994 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9994 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9984 )PATH - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9975 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PT' ) ) THEN -* -* PT: Positive definite tridiagonal -* - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9993 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9993 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = 9986 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9973 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9978 )4 - WRITE( IOUNIT, FMT = 9977 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'SP' ) ) THEN -* -* SY: Symmetric indefinite full -* SP: Symmetric indefinite packed -* - IF( LSAME( C3, 'Y' ) ) THEN - WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9991 )PATH, 'Symmetric' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9983 ) - ELSE - WRITE( IOUNIT, FMT = 9982 ) - END IF - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9974 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9977 )4 - WRITE( IOUNIT, FMT = 9978 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. LSAMEN( 2, P2, 'HP' ) ) THEN -* -* HE: Hermitian indefinite full -* HP: Hermitian indefinite packed -* - IF( LSAME( C3, 'E' ) ) THEN - WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian' - ELSE - WRITE( IOUNIT, FMT = 9991 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9983 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9974 )1 - WRITE( IOUNIT, FMT = 9980 )2 - WRITE( IOUNIT, FMT = 9979 )3 - WRITE( IOUNIT, FMT = 9977 )4 - WRITE( IOUNIT, FMT = 9978 )5 - WRITE( IOUNIT, FMT = 9976 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE -* -* Print error message if no header is available. -* - WRITE( IOUNIT, FMT = 9990 )PATH - END IF -* -* First line of header -* - 9999 FORMAT( / 1X, A3, ' drivers: General dense matrices' ) - 9998 FORMAT( / 1X, A3, ' drivers: General band matrices' ) - 9997 FORMAT( / 1X, A3, ' drivers: General tridiagonal' ) - 9996 FORMAT( / 1X, A3, ' drivers: ', A9, - $ ' positive definite matrices' ) - 9995 FORMAT( / 1X, A3, ' drivers: ', A9, - $ ' positive definite packed matrices' ) - 9994 FORMAT( / 1X, A3, ' drivers: ', A9, - $ ' positive definite band matrices' ) - 9993 FORMAT( / 1X, A3, ' drivers: ', A9, - $ ' positive definite tridiagonal' ) - 9992 FORMAT( / 1X, A3, ' drivers: ', A9, ' indefinite matrices' ) - 9991 FORMAT( / 1X, A3, ' drivers: ', A9, - $ ' indefinite packed matrices' ) - 9990 FORMAT( / 1X, A3, ': No header available' ) -* -* GE matrix types -* - 9989 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X, - $ '2. Upper triangular', 16X, - $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS', - $ / 4X, '4. Random, CNDNUM = 2', 13X, - $ '10. Scaled near underflow', / 4X, '5. First column zero', - $ 14X, '11. Scaled near overflow', / 4X, - $ '6. Last column zero' ) -* -* GB matrix types -* - 9988 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, - $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. First column zero', 15X, '6. Random, CNDNUM = 0.1/EPS', - $ / 4X, '3. Last column zero', 16X, - $ '7. Scaled near underflow', / 4X, - $ '4. Last n/2 columns zero', 11X, '8. Scaled near overflow' ) -* -* GT matrix types -* - 9987 FORMAT( ' Matrix types (1-6 have specified condition numbers):', - $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', - $ / 4X, '2. Random, CNDNUM = 2', 14X, '8. First column zero', - $ / 4X, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, - $ '9. Last column zero', / 4X, '4. Random, CNDNUM = 0.1/EPS', - $ 7X, '10. Last n/2 columns zero', / 4X, - $ '5. Scaled near underflow', 10X, - $ '11. Scaled near underflow', / 4X, - $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) -* -* PT matrix types -* - 9986 FORMAT( ' Matrix types (1-6 have specified condition numbers):', - $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', - $ / 4X, '2. Random, CNDNUM = 2', 14X, - $ '8. First row and column zero', / 4X, - $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, - $ '9. Last row and column zero', / 4X, - $ '4. Random, CNDNUM = 0.1/EPS', 7X, - $ '10. Middle row and column zero', / 4X, - $ '5. Scaled near underflow', 10X, - $ '11. Scaled near underflow', / 4X, - $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) -* -* PO, PP matrix types -* - 9985 FORMAT( 4X, '1. Diagonal', 24X, - $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '7. Random, CNDNUM = 0.1/EPS', - $ / 3X, '*3. First row and column zero', 7X, - $ '8. Scaled near underflow', / 3X, - $ '*4. Last row and column zero', 8X, - $ '9. Scaled near overflow', / 3X, - $ '*5. Middle row and column zero', / 3X, - $ '(* - tests error exits from ', A3, - $ 'TRF, no test ratios are computed)' ) -* -* PB matrix types -* - 9984 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, - $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3X, - $ '*2. First row and column zero', 7X, - $ '6. Random, CNDNUM = 0.1/EPS', / 3X, - $ '*3. Last row and column zero', 8X, - $ '7. Scaled near underflow', / 3X, - $ '*4. Middle row and column zero', 6X, - $ '8. Scaled near overflow', / 3X, - $ '(* - tests error exits from ', A3, - $ 'TRF, no test ratios are computed)' ) -* -* SSY, SSP, CHE, CHP matrix types -* - 9983 FORMAT( 4X, '1. Diagonal', 24X, - $ '6. Last n/2 rows and columns zero', / 4X, - $ '2. Random, CNDNUM = 2', 14X, - $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '3. First row and column zero', 7X, - $ '8. Random, CNDNUM = 0.1/EPS', / 4X, - $ '4. Last row and column zero', 8X, - $ '9. Scaled near underflow', / 4X, - $ '5. Middle row and column zero', 5X, - $ '10. Scaled near overflow' ) -* -* CSY, CSP matrix types -* - 9982 FORMAT( 4X, '1. Diagonal', 24X, - $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '8. Random, CNDNUM = 0.1/EPS', - $ / 4X, '3. First row and column zero', 7X, - $ '9. Scaled near underflow', / 4X, - $ '4. Last row and column zero', 7X, - $ '10. Scaled near overflow', / 4X, - $ '5. Middle row and column zero', 5X, - $ '11. Block diagonal matrix', / 4X, - $ '6. Last n/2 rows and columns zero' ) -* -* Test ratios -* - 9981 FORMAT( 3X, I2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' ) - 9980 FORMAT( 3X, I2, ': norm( B - A * X ) / ', - $ '( norm(A) * norm(X) * EPS )' ) - 9979 FORMAT( 3X, I2, ': norm( X - XACT ) / ', - $ '( norm(XACT) * CNDNUM * EPS )' ) - 9978 FORMAT( 3X, I2, ': norm( X - XACT ) / ', - $ '( norm(XACT) * (error bound) )' ) - 9977 FORMAT( 3X, I2, ': (backward error) / EPS' ) - 9976 FORMAT( 3X, I2, ': RCOND * CNDNUM - 1.0' ) - 9975 FORMAT( 3X, I2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 9974 FORMAT( 3X, I2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 9973 FORMAT( 3X, I2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 9972 FORMAT( 3X, I2, ': abs( WORK(1) - RPVGRW ) /', - $ ' ( max( WORK(1), RPVGRW ) * EPS )' ) -* - RETURN -* -* End of ALADHD -* - END diff --git a/testing/lin/alaerh.f b/testing/lin/alaerh.f deleted file mode 100644 index de939cf397d32309a2c3cc0fa31a43597cdcc5d6..0000000000000000000000000000000000000000 --- a/testing/lin/alaerh.f +++ /dev/null @@ -1,1093 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, - $ N5, IMAT, NFAIL, NERRS, NOUT ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - CHARACTER*( * ) SUBNAM - CHARACTER*( * ) OPTS - INTEGER IMAT, INFO, INFOE, KL, KU, M, N, N5, NERRS, - $ NFAIL, NOUT -* .. -* -* Purpose -* ======= -* -* ALAERH is an error handler for the LAPACK routines. It prints the -* header if this is the first error message and prints the error code -* and form of recovery, if any. The character evaluations in this -* routine may make it slow, but it should not be called once the LAPACK -* routines are fully debugged. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name of subroutine SUBNAM. -* -* SUBNAM (input) CHARACTER*(*) -* The name of the subroutine that returned an error code. -* -* INFO (input) INTEGER -* The error code returned from routine SUBNAM. -* -* INFOE (input) INTEGER -* The expected error code from routine SUBNAM, if SUBNAM were -* error-free. If INFOE = 0, an error message is printed, but -* if INFOE.NE.0, we assume only the return code INFO is wrong. -* -* OPTS (input) CHARACTER*(*) -* The character options to the subroutine SUBNAM, concatenated -* into a single character string. For example, UPLO = 'U', -* TRANS = 'T', and DIAG = 'N' for a triangular routine would -* be specified as OPTS = 'UTN'. -* -* M (input) INTEGER -* The matrix row dimension. -* -* N (input) INTEGER -* The matrix column dimension. Accessed only if PATH = xGE or -* xGB. -* -* KL (input) INTEGER -* The number of sub-diagonals of the matrix. Accessed only if -* PATH = xGB, xPB, or xTB. Also used for NRHS for PATH = xLS. -* -* KU (input) INTEGER -* The number of super-diagonals of the matrix. Accessed only -* if PATH = xGB. -* -* N5 (input) INTEGER -* A fifth integer parameter, may be the blocksize NB or the -* number of right hand sides NRHS. -* -* IMAT (input) INTEGER -* The matrix type. -* -* NFAIL (input) INTEGER -* The number of prior tests that did not pass the threshold; -* used to determine if the header should be printed. -* -* NERRS (input/output) INTEGER -* On entry, the number of errors already detected; used to -* determine if the header should be printed. -* On exit, NERRS is increased by 1. -* -* NOUT (input) INTEGER -* The unit number on which results are to be printed. -* -* ===================================================================== -* -* .. Local Scalars .. - CHARACTER UPLO - CHARACTER*2 P2 - CHARACTER*3 C3 -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. Intrinsic Functions .. - INTRINSIC LEN_TRIM -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAHD -* .. -* .. Executable Statements .. -* - IF( INFO.EQ.0 ) - $ RETURN - P2 = PATH( 2: 3 ) - C3 = SUBNAM( 4: 6 ) -* -* Print the header if this is the first error message. -* - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN - IF( LSAMEN( 3, C3, 'SV ' ) .OR. LSAMEN( 3, C3, 'SVX' ) ) THEN - CALL ALADHD( NOUT, PATH ) - ELSE - CALL ALAHD( NOUT, PATH ) - END IF - END IF - NERRS = NERRS + 1 -* -* Print the message detailing the error and form of recovery, -* if any. -* - IF( LSAMEN( 2, P2, 'GE' ) ) THEN -* -* xGE: General matrices -* - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9988 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, M, N, N5, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9975 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, N5, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9984 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, N5, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9970 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9992 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9997 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN -* - WRITE( NOUT, FMT = 9971 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, N5, IMAT -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN -* - WRITE( NOUT, FMT = 9978 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT -* - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9969 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, - $ IMAT -* - ELSE IF( LSAMEN( 3, C3, 'LS ' ) ) THEN -* - WRITE( NOUT, FMT = 9965 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, N, - $ KL, N5, IMAT -* - ELSE IF( LSAMEN( 3, C3, 'LSX' ) .OR. LSAMEN( 3, C3, 'LSS' ) ) - $ THEN -* - WRITE( NOUT, FMT = 9974 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9963 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN -* -* xGB: General band matrices -* - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9989 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, M, N, KL, - $ KU, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9976 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, KU, N5, - $ IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9986 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, KL, KU, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9972 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, KL, KU, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9993 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, KL, KU, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9998 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, KL, KU, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN -* - WRITE( NOUT, FMT = 9977 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, KU, IMAT -* - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9968 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, KL, - $ KU, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9964 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, KL, - $ KU, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN -* -* xGT: General tridiagonal matrices -* - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9987 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, IMAT - ELSE - WRITE( NOUT, FMT = 9973 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9984 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, N5, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9970 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9992 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9997 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9969 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, - $ IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9963 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'PO' ) ) THEN -* -* xPO: Symmetric or Hermitian positive definite matrices -* - UPLO = OPTS( 1: 1 ) - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9980 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, M, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9956 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9979 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, N, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9990 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9995 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN -* - WRITE( NOUT, FMT = 9956 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) .OR. - $ LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9960 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'PS' ) ) THEN -* -* xPS: Symmetric or Hermitian positive semi-definite matrices -* - UPLO = OPTS( 1: 1 ) - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9980 )SUBNAM, INFO, INFOE, UPLO, M, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9956 )SUBNAM, INFO, UPLO, M, N5, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9979 )SUBNAM, INFO, INFOE, UPLO, N, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9955 )SUBNAM, INFO, UPLO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9990 )SUBNAM, INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9995 )SUBNAM, INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN -* - WRITE( NOUT, FMT = 9956 )SUBNAM, INFO, UPLO, M, N5, IMAT -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMT' ) .OR. - $ LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9960 )SUBNAM, INFO, UPLO, M, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9955 )SUBNAM, INFO, UPLO, M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'HE' ) ) THEN -* -* xHE, or xSY: Symmetric or Hermitian indefinite matrices -* - UPLO = OPTS( 1: 1 ) - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9980 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, M, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9956 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9979 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, N, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9990 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9995 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) .OR. - $ LSAMEN( 3, C3, 'TRI' ) .OR. LSAMEN( 3, C3, 'CON' ) ) - $ THEN -* - WRITE( NOUT, FMT = 9960 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'PP' ) .OR. LSAMEN( 2, P2, 'SP' ) .OR. - $ LSAMEN( 2, P2, 'HP' ) ) THEN -* -* xPP, xHP, or xSP: Symmetric or Hermitian packed matrices -* - UPLO = OPTS( 1: 1 ) - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9983 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, M, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9960 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9979 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, N, - $ N5, IMAT - ELSE - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9990 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9995 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) .OR. - $ LSAMEN( 3, C3, 'TRI' ) .OR. LSAMEN( 3, C3, 'CON' ) ) - $ THEN -* - WRITE( NOUT, FMT = 9960 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9955 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'PB' ) ) THEN -* -* xPB: Symmetric (Hermitian) positive definite band matrix -* - UPLO = OPTS( 1: 1 ) - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9982 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, M, - $ KL, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9958 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, KL, N5, - $ IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9981 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, UPLO, N, - $ KL, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9957 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, N, KL, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9991 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), OPTS( 2: 2 ), N, KL, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9996 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), N, KL, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) .OR. - $ LSAMEN( 3, C3, 'CON' ) ) THEN -* - WRITE( NOUT, FMT = 9959 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, KL, IMAT -* - ELSE -* - WRITE( NOUT, FMT = 9957 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, UPLO, M, KL, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'PT' ) ) THEN -* -* xPT: Positive definite tridiagonal matrices -* - IF( LSAMEN( 3, C3, 'TRF' ) ) THEN - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9987 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, IMAT - ELSE - WRITE( NOUT, FMT = 9973 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, IMAT - END IF - IF( INFO.NE.0 ) - $ WRITE( NOUT, FMT = 9949 ) -* - ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9984 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, N, N5, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9970 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9994 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, - $ OPTS( 1: 1 ), N, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9999 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), N, - $ N5, IMAT - END IF -* - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN -* - IF( LSAME( SUBNAM( 1: 1 ), 'S' ) .OR. - $ LSAME( SUBNAM( 1: 1 ), 'D' ) ) THEN - WRITE( NOUT, FMT = 9973 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, IMAT - ELSE - WRITE( NOUT, FMT = 9969 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, - $ IMAT - END IF -* - ELSE -* - WRITE( NOUT, FMT = 9963 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), M, N5, - $ IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'TR' ) ) THEN -* -* xTR: Triangular matrix -* - IF( LSAMEN( 3, C3, 'TRI' ) ) THEN - WRITE( NOUT, FMT = 9961 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), M, N5, IMAT - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN - WRITE( NOUT, FMT = 9967 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATRS' ) ) THEN - WRITE( NOUT, FMT = 9952 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), OPTS( 4: 4 ), M, IMAT - ELSE - WRITE( NOUT, FMT = 9953 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'TP' ) ) THEN -* -* xTP: Triangular packed matrix -* - IF( LSAMEN( 3, C3, 'TRI' ) ) THEN - WRITE( NOUT, FMT = 9962 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), M, IMAT - ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN - WRITE( NOUT, FMT = 9967 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATPS' ) ) THEN - WRITE( NOUT, FMT = 9952 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), OPTS( 4: 4 ), M, IMAT - ELSE - WRITE( NOUT, FMT = 9953 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'TB' ) ) THEN -* -* xTB: Triangular band matrix -* - IF( LSAMEN( 3, C3, 'CON' ) ) THEN - WRITE( NOUT, FMT = 9966 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, KL, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATBS' ) ) THEN - WRITE( NOUT, FMT = 9951 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), OPTS( 4: 4 ), M, KL, IMAT - ELSE - WRITE( NOUT, FMT = 9954 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, OPTS( 1: 1 ), - $ OPTS( 2: 2 ), OPTS( 3: 3 ), M, KL, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'QR' ) ) THEN -* -* xQR: QR factorization -* - IF( LSAMEN( 3, C3, 'QRS' ) ) THEN - WRITE( NOUT, FMT = 9974 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN - WRITE( NOUT, FMT = 9978 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'LQ' ) ) THEN -* -* xLQ: LQ factorization -* - IF( LSAMEN( 3, C3, 'LQS' ) ) THEN - WRITE( NOUT, FMT = 9974 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN - WRITE( NOUT, FMT = 9978 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'QL' ) ) THEN -* -* xQL: QL factorization -* - IF( LSAMEN( 3, C3, 'QLS' ) ) THEN - WRITE( NOUT, FMT = 9974 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN - WRITE( NOUT, FMT = 9978 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'RQ' ) ) THEN -* -* xRQ: RQ factorization -* - IF( LSAMEN( 3, C3, 'RQS' ) ) THEN - WRITE( NOUT, FMT = 9974 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT - ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN - WRITE( NOUT, FMT = 9978 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'LU' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9988 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, M, N, N5, - $ IMAT - ELSE - WRITE( NOUT, FMT = 9975 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, N5, IMAT - END IF -* - ELSE IF( LSAMEN( 2, P2, 'CH' ) ) THEN -* - IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN - WRITE( NOUT, FMT = 9985 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, INFOE, M, N5, IMAT - ELSE - WRITE( NOUT, FMT = 9971 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N5, IMAT - END IF -* - ELSE -* -* Print a generic message if the path is unknown. -* - WRITE( NOUT, FMT = 9950 ) - $ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO - END IF -* -* Description of error message (alphabetical, left to right) -* -* SUBNAM, INFO, FACT, N, NRHS, IMAT -* - 9999 FORMAT( ' *** Error code from ', A, '=', I5, ', FACT=''', A1, - $ ''', N=', I5, ', NRHS=', I4, ', type ', I2 ) -* -* SUBNAM, INFO, FACT, TRANS, N, KL, KU, NRHS, IMAT -* - 9998 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> FACT=''', - $ A1, ''', TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', - $ I5, ', NRHS=', I4, ', type ', I1 ) -* -* SUBNAM, INFO, FACT, TRANS, N, NRHS, IMAT -* - 9997 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> FACT=''', - $ A1, ''', TRANS=''', A1, ''', N =', I5, ', NRHS =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, FACT, UPLO, N, KD, NRHS, IMAT -* - 9996 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> FACT=''', - $ A1, ''', UPLO=''', A1, ''', N=', I5, ', KD=', I5, ', NRHS=', - $ I4, ', type ', I2 ) -* -* SUBNAM, INFO, FACT, UPLO, N, NRHS, IMAT -* - 9995 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> FACT=''', - $ A1, ''', UPLO=''', A1, ''', N =', I5, ', NRHS =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, FACT, N, NRHS, IMAT -* - 9994 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> FACT=''', A1, ''', N =', I5, ', NRHS =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, FACT, TRANS, N, KL, KU, NRHS, IMAT -* - 9993 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', KL=', I5, ', KU=', I5, ', NRHS=', I4, ', type ', I1 ) -* -* SUBNAM, INFO, INFOE, FACT, TRANS, N, NRHS, IMAT -* - 9992 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> FACT=''', A1, ''', TRANS=''', A1, ''', N =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, FACT, UPLO, N, KD, NRHS, IMAT -* - 9991 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', KD=', I5, ', NRHS=', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, FACT, UPLO, N, NRHS, IMAT -* - 9990 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, M, N, KL, KU, NB, IMAT -* - 9989 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> M = ', I5, ', N =', I5, ', KL =', I5, ', KU =', - $ I5, ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, M, N, NB, IMAT -* - 9988 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> M =', I5, ', N =', I5, ', NB =', I4, ', type ', - $ I2 ) -* -* SUBNAM, INFO, INFOE, N, IMAT -* - 9987 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, ' for N=', I5, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, N, KL, KU, NRHS, IMAT -* - 9986 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> N =', I5, ', KL =', I5, ', KU =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, N, NB, IMAT -* - 9985 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> N =', I5, ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, N, NRHS, IMAT -* - 9984 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> N =', I5, ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, UPLO, N, IMAT -* - 9983 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> UPLO = ''', A1, ''', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, UPLO, N, KD, NB, IMAT -* - 9982 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> UPLO = ''', A1, ''', N =', I5, ', KD =', I5, - $ ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, UPLO, N, KD, NRHS, IMAT -* - 9981 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> UPLO=''', A1, ''', N =', I5, ', KD =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, UPLO, N, NB, IMAT -* - 9980 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> UPLO = ''', A1, ''', N =', I5, ', NB =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, INFOE, UPLO, N, NRHS, IMAT -* - 9979 FORMAT( ' *** ', A, ' returned with INFO =', I5, ' instead of ', - $ I2, / ' ==> UPLO = ''', A1, ''', N =', I5, ', NRHS =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, M, N, IMAT -* - 9978 FORMAT( ' *** Error code from ', A, ' =', I5, ' for M =', I5, - $ ', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, M, N, KL, KU, IMAT -* - 9977 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> M = ', I5, - $ ', N =', I5, ', KL =', I5, ', KU =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, M, N, KL, KU, NB, IMAT -* - 9976 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> M = ', I5, - $ ', N =', I5, ', KL =', I5, ', KU =', I5, ', NB =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, M, N, NB, IMAT -* - 9975 FORMAT( ' *** Error code from ', A, '=', I5, ' for M=', I5, - $ ', N=', I5, ', NB=', I4, ', type ', I2 ) -* -* SUBNAM, INFO, M, N, NRHS, NB, IMAT -* - 9974 FORMAT( ' *** Error code from ', A, '=', I5, / ' ==> M =', I5, - $ ', N =', I5, ', NRHS =', I4, ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, N, IMAT -* - 9973 FORMAT( ' *** Error code from ', A, ' =', I5, ' for N =', I5, - $ ', type ', I2 ) -* -* SUBNAM, INFO, N, KL, KU, NRHS, IMAT -* - 9972 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> N =', I5, - $ ', KL =', I5, ', KU =', I5, ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, N, NB, IMAT -* - 9971 FORMAT( ' *** Error code from ', A, '=', I5, ' for N=', I5, - $ ', NB=', I4, ', type ', I2 ) -* -* SUBNAM, INFO, N, NRHS, IMAT -* - 9970 FORMAT( ' *** Error code from ', A, ' =', I5, ' for N =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, NORM, N, IMAT -* - 9969 FORMAT( ' *** Error code from ', A, ' =', I5, ' for NORM = ''', - $ A1, ''', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, NORM, N, KL, KU, IMAT -* - 9968 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> NORM =''', - $ A1, ''', N =', I5, ', KL =', I5, ', KU =', I5, ', type ', - $ I2 ) -* -* SUBNAM, INFO, NORM, UPLO, DIAG, N, IMAT -* - 9967 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> NORM=''', - $ A1, ''', UPLO =''', A1, ''', DIAG=''', A1, ''', N =', I5, - $ ', type ', I2 ) -* -* SUBNAM, INFO, NORM, UPLO, DIAG, N, KD, IMAT -* - 9966 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> NORM=''', - $ A1, ''', UPLO =''', A1, ''', DIAG=''', A1, ''', N=', I5, - $ ', KD=', I5, ', type ', I2 ) -* -* SUBNAM, INFO, TRANS, M, N, NRHS, NB, IMAT -* - 9965 FORMAT( ' *** Error code from ', A, ' =', I5, - $ / ' ==> TRANS = ''', A1, ''', M =', I5, ', N =', I5, - $ ', NRHS =', I4, ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, TRANS, N, KL, KU, NRHS, IMAT -* - 9964 FORMAT( ' *** Error code from ', A, '=', I5, / ' ==> TRANS=''', - $ A1, ''', N =', I5, ', KL =', I5, ', KU =', I5, ', NRHS =', - $ I4, ', type ', I2 ) -* -* SUBNAM, INFO, TRANS, N, NRHS, IMAT -* - 9963 FORMAT( ' *** Error code from ', A, ' =', I5, - $ / ' ==> TRANS = ''', A1, ''', N =', I5, ', NRHS =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, DIAG, N, IMAT -* - 9962 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', DIAG =''', A1, ''', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, DIAG, N, NB, IMAT -* - 9961 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', DIAG =''', A1, ''', N =', I5, ', NB =', I4, - $ ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, N, IMAT -* - 9960 FORMAT( ' *** Error code from ', A, ' =', I5, ' for UPLO = ''', - $ A1, ''', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, N, KD, IMAT -* - 9959 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO = ''', - $ A1, ''', N =', I5, ', KD =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, N, KD, NB, IMAT -* - 9958 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO = ''', - $ A1, ''', N =', I5, ', KD =', I5, ', NB =', I4, ', type ', - $ I2 ) -* -* SUBNAM, INFO, UPLO, N, KD, NRHS, IMAT -* - 9957 FORMAT( ' *** Error code from ', A, '=', I5, / ' ==> UPLO = ''', - $ A1, ''', N =', I5, ', KD =', I5, ', NRHS =', I4, ', type ', - $ I2 ) -* -* SUBNAM, INFO, UPLO, N, NB, IMAT -* - 9956 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO = ''', - $ A1, ''', N =', I5, ', NB =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, N, NRHS, IMAT -* - 9955 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO = ''', - $ A1, ''', N =', I5, ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, TRANS, DIAG, N, KD, NRHS, IMAT -* - 9954 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', TRANS=''', A1, ''', DIAG=''', A1, ''', N=', I5, - $ ', KD=', I5, ', NRHS=', I4, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, TRANS, DIAG, N, NRHS, IMAT -* - 9953 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', TRANS=''', A1, ''', DIAG=''', A1, ''', N =', I5, - $ ', NRHS =', I4, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, TRANS, DIAG, NORMIN, N, IMAT -* - 9952 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', TRANS=''', A1, ''', DIAG=''', A1, ''', NORMIN=''', - $ A1, ''', N =', I5, ', type ', I2 ) -* -* SUBNAM, INFO, UPLO, TRANS, DIAG, NORMIN, N, KD, IMAT -* - 9951 FORMAT( ' *** Error code from ', A, ' =', I5, / ' ==> UPLO=''', - $ A1, ''', TRANS=''', A1, ''', DIAG=''', A1, ''', NORMIN=''', - $ A1, ''', N=', I5, ', KD=', I5, ', type ', I2 ) -* -* Unknown type -* - 9950 FORMAT( ' *** Error code from ', A, ' =', I5 ) -* -* What we do next -* - 9949 FORMAT( ' ==> Doing only the condition estimate for this case' ) -* - RETURN -* -* End of ALAERH -* - END diff --git a/testing/lin/alaesm.f b/testing/lin/alaesm.f deleted file mode 100644 index 95b69d1485d2892888178c2349555c169ad8ff99..0000000000000000000000000000000000000000 --- a/testing/lin/alaesm.f +++ /dev/null @@ -1,87 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALAESM( PATH, OK, NOUT ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL OK - CHARACTER*3 PATH - INTEGER NOUT -* .. -* -* Purpose -* ======= -* -* ALAESM prints a summary of results from one of the -ERR- routines. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name. -* -* OK (input) LOGICAL -* The flag from CHKXER that indicates whether or not the tests -* of error exits passed. -* -* NOUT (input) INTEGER -* The unit number on which results are to be printed. -* NOUT >= 0. -* -* ===================================================================== -* -* .. Executable Statements .. -* - IF( OK ) THEN - WRITE( NOUT, FMT = 9999 )PATH - ELSE - WRITE( NOUT, FMT = 9998 )PATH - END IF -* - 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits' - $ ) - 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', - $ 'exits ***' ) - RETURN -* -* End of ALAESM -* - END diff --git a/testing/lin/alahd.f b/testing/lin/alahd.f deleted file mode 100644 index 52b53dd6236959059d1fcc447c9da97f4624aefe..0000000000000000000000000000000000000000 --- a/testing/lin/alahd.f +++ /dev/null @@ -1,814 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALAHD( IOUNIT, PATH ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER IOUNIT -* .. -* -* Purpose -* ======= -* -* ALAHD prints header information for the different test paths. -* -* Arguments -* ========= -* -* IOUNIT (input) INTEGER -* The unit number to which the header information should be -* printed. -* -* PATH (input) CHARACTER*3 -* The name of the path for which the header information is to -* be printed. Current paths are -* _GE: General matrices -* _GB: General band -* _GT: General Tridiagonal -* _PO: Symmetric or Hermitian positive definite -* _PS: Symmetric or Hermitian positive semi-definite -* _PP: Symmetric or Hermitian positive definite packed -* _PB: Symmetric or Hermitian positive definite band -* _PT: Symmetric or Hermitian positive definite tridiagonal -* _SY: Symmetric indefinite -* _SP: Symmetric indefinite packed -* _HE: (complex) Hermitian indefinite -* _HP: (complex) Hermitian indefinite packed -* _TR: Triangular -* _TP: Triangular packed -* _TB: Triangular band -* _QR: QR (general matrices) -* _LQ: LQ (general matrices) -* _QL: QL (general matrices) -* _RQ: RQ (general matrices) -* _QP: QR with column pivoting -* _TZ: Trapezoidal -* _LS: Least Squares driver routines -* _LU: LU variants -* _CH: Cholesky variants -* _QS: QR variants -* The first character must be one of S, D, C, or Z (C or Z only -* if complex). -* -* ===================================================================== -* -* .. Local Scalars .. - LOGICAL CORZ, SORD - CHARACTER C1, C3 - CHARACTER*2 P2 - CHARACTER*4 EIGCNM - CHARACTER*32 SUBNAM - CHARACTER*9 SYM -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. Intrinsic Functions .. - INTRINSIC LEN_TRIM -* .. -* .. Executable Statements .. -* - IF( IOUNIT.LE.0 ) - $ RETURN - C1 = PATH( 1: 1 ) - C3 = PATH( 3: 3 ) - P2 = PATH( 2: 3 ) - SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) - CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' ) - IF( .NOT.( SORD .OR. CORZ ) ) - $ RETURN -* - IF( LSAMEN( 2, P2, 'GE' ) ) THEN -* -* GE: General dense -* - WRITE( IOUNIT, FMT = 9999 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9979 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9962 )1 - WRITE( IOUNIT, FMT = 9961 )2 - WRITE( IOUNIT, FMT = 9960 )3 - WRITE( IOUNIT, FMT = 9959 )4 - WRITE( IOUNIT, FMT = 9958 )5 - WRITE( IOUNIT, FMT = 9957 )6 - WRITE( IOUNIT, FMT = 9956 )7 - WRITE( IOUNIT, FMT = 9955 )8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN -* -* GB: General band -* - WRITE( IOUNIT, FMT = 9998 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9978 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9962 )1 - WRITE( IOUNIT, FMT = 9960 )2 - WRITE( IOUNIT, FMT = 9959 )3 - WRITE( IOUNIT, FMT = 9958 )4 - WRITE( IOUNIT, FMT = 9957 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9955 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN -* -* GT: General tridiagonal -* - WRITE( IOUNIT, FMT = 9997 )PATH - WRITE( IOUNIT, FMT = 9977 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9962 )1 - WRITE( IOUNIT, FMT = 9960 )2 - WRITE( IOUNIT, FMT = 9959 )3 - WRITE( IOUNIT, FMT = 9958 )4 - WRITE( IOUNIT, FMT = 9957 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9955 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PO' ) .OR. LSAMEN( 2, P2, 'PP' ) ) THEN -* -* PO: Positive definite full -* PP: Positive definite packed -* - IF( SORD ) THEN - SYM = 'Symmetric' - ELSE - SYM = 'Hermitian' - END IF - IF( LSAME( C3, 'O' ) ) THEN - WRITE( IOUNIT, FMT = 9996 )PATH, SYM - ELSE - WRITE( IOUNIT, FMT = 9995 )PATH, SYM - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9975 )PATH - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9954 )1 - WRITE( IOUNIT, FMT = 9961 )2 - WRITE( IOUNIT, FMT = 9960 )3 - WRITE( IOUNIT, FMT = 9959 )4 - WRITE( IOUNIT, FMT = 9958 )5 - WRITE( IOUNIT, FMT = 9957 )6 - WRITE( IOUNIT, FMT = 9956 )7 - WRITE( IOUNIT, FMT = 9955 )8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PS' ) ) THEN -* -* PS: Positive semi-definite full -* - IF( SORD ) THEN - SYM = 'Symmetric' - ELSE - SYM = 'Hermitian' - END IF - IF( LSAME( C1, 'S' ) .OR. LSAME( C1, 'C' ) ) THEN - EIGCNM = '1E04' - ELSE - EIGCNM = '1D12' - END IF - WRITE( IOUNIT, FMT = 9995 )PATH, SYM - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 8973 )EIGCNM, EIGCNM, EIGCNM - WRITE( IOUNIT, FMT = '( '' Difference:'' )' ) - WRITE( IOUNIT, FMT = 8972 )C1 - WRITE( IOUNIT, FMT = '( '' Test ratio:'' )' ) - WRITE( IOUNIT, FMT = 8950 ) - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) - ELSE IF( LSAMEN( 2, P2, 'PB' ) ) THEN -* -* PB: Positive definite band -* - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9994 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9994 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9973 )PATH - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9954 )1 - WRITE( IOUNIT, FMT = 9960 )2 - WRITE( IOUNIT, FMT = 9959 )3 - WRITE( IOUNIT, FMT = 9958 )4 - WRITE( IOUNIT, FMT = 9957 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9955 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'PT' ) ) THEN -* -* PT: Positive definite tridiagonal -* - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9993 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9993 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = 9976 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9952 )1 - WRITE( IOUNIT, FMT = 9960 )2 - WRITE( IOUNIT, FMT = 9959 )3 - WRITE( IOUNIT, FMT = 9958 )4 - WRITE( IOUNIT, FMT = 9957 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9955 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'SP' ) ) THEN -* -* SY: Symmetric indefinite full -* SP: Symmetric indefinite packed -* - IF( LSAME( C3, 'Y' ) ) THEN - WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric' - ELSE - WRITE( IOUNIT, FMT = 9991 )PATH, 'Symmetric' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - IF( SORD ) THEN - WRITE( IOUNIT, FMT = 9972 ) - ELSE - WRITE( IOUNIT, FMT = 9971 ) - END IF - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9953 )1 - WRITE( IOUNIT, FMT = 9961 )2 - WRITE( IOUNIT, FMT = 9960 )3 - WRITE( IOUNIT, FMT = 9959 )4 - WRITE( IOUNIT, FMT = 9958 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9957 )7 - WRITE( IOUNIT, FMT = 9955 )8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. LSAMEN( 2, P2, 'HP' ) ) THEN -* -* HE: Hermitian indefinite full -* HP: Hermitian indefinite packed -* - IF( LSAME( C3, 'E' ) ) THEN - WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian' - ELSE - WRITE( IOUNIT, FMT = 9991 )PATH, 'Hermitian' - END IF - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9972 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9953 )1 - WRITE( IOUNIT, FMT = 9961 )2 - WRITE( IOUNIT, FMT = 9960 )3 - WRITE( IOUNIT, FMT = 9959 )4 - WRITE( IOUNIT, FMT = 9958 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9957 )7 - WRITE( IOUNIT, FMT = 9955 )8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'TR' ) .OR. LSAMEN( 2, P2, 'TP' ) ) THEN -* -* TR: Triangular full -* TP: Triangular packed -* - IF( LSAME( C3, 'R' ) ) THEN - WRITE( IOUNIT, FMT = 9990 )PATH - SUBNAM = PATH( 1: 1 ) // 'LATRS' - ELSE - WRITE( IOUNIT, FMT = 9989 )PATH - SUBNAM = PATH( 1: 1 ) // 'LATPS' - END IF - WRITE( IOUNIT, FMT = 9966 )PATH - WRITE( IOUNIT, FMT = 9965 )SUBNAM(1:LEN_TRIM( SUBNAM )) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9961 )1 - WRITE( IOUNIT, FMT = 9960 )2 - WRITE( IOUNIT, FMT = 9959 )3 - WRITE( IOUNIT, FMT = 9958 )4 - WRITE( IOUNIT, FMT = 9957 )5 - WRITE( IOUNIT, FMT = 9956 )6 - WRITE( IOUNIT, FMT = 9955 )7 - WRITE( IOUNIT, FMT = 9951 )SUBNAM(1:LEN_TRIM( SUBNAM )), 8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'TB' ) ) THEN -* -* TB: Triangular band -* - WRITE( IOUNIT, FMT = 9988 )PATH - SUBNAM = PATH( 1: 1 ) // 'LATBS' - WRITE( IOUNIT, FMT = 9964 )PATH - WRITE( IOUNIT, FMT = 9963 )SUBNAM(1:LEN_TRIM( SUBNAM )) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9960 )1 - WRITE( IOUNIT, FMT = 9959 )2 - WRITE( IOUNIT, FMT = 9958 )3 - WRITE( IOUNIT, FMT = 9957 )4 - WRITE( IOUNIT, FMT = 9956 )5 - WRITE( IOUNIT, FMT = 9955 )6 - WRITE( IOUNIT, FMT = 9951 )SUBNAM(1:LEN_TRIM( SUBNAM )), 7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'QR' ) ) THEN -* -* QR decomposition of rectangular matrices -* - WRITE( IOUNIT, FMT = 9987 )PATH, 'QR' - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9970 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9950 )1 - WRITE( IOUNIT, FMT = 9946 )2 - WRITE( IOUNIT, FMT = 9944 )3, 'M' - WRITE( IOUNIT, FMT = 9943 )4, 'M' - WRITE( IOUNIT, FMT = 9942 )5, 'M' - WRITE( IOUNIT, FMT = 9941 )6, 'M' - WRITE( IOUNIT, FMT = 9960 )7 - WRITE( IOUNIT, FMT = 6660 )8 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'LQ' ) ) THEN -* -* LQ decomposition of rectangular matrices -* - WRITE( IOUNIT, FMT = 9987 )PATH, 'LQ' - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9970 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9949 )1 - WRITE( IOUNIT, FMT = 9945 )2 - WRITE( IOUNIT, FMT = 9944 )3, 'N' - WRITE( IOUNIT, FMT = 9943 )4, 'N' - WRITE( IOUNIT, FMT = 9942 )5, 'N' - WRITE( IOUNIT, FMT = 9941 )6, 'N' - WRITE( IOUNIT, FMT = 9960 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'QL' ) ) THEN -* -* QL decomposition of rectangular matrices -* - WRITE( IOUNIT, FMT = 9987 )PATH, 'QL' - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9970 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9948 )1 - WRITE( IOUNIT, FMT = 9946 )2 - WRITE( IOUNIT, FMT = 9944 )3, 'M' - WRITE( IOUNIT, FMT = 9943 )4, 'M' - WRITE( IOUNIT, FMT = 9942 )5, 'M' - WRITE( IOUNIT, FMT = 9941 )6, 'M' - WRITE( IOUNIT, FMT = 9960 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'RQ' ) ) THEN -* -* RQ decomposition of rectangular matrices -* - WRITE( IOUNIT, FMT = 9987 )PATH, 'RQ' - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9970 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9947 )1 - WRITE( IOUNIT, FMT = 9945 )2 - WRITE( IOUNIT, FMT = 9944 )3, 'N' - WRITE( IOUNIT, FMT = 9943 )4, 'N' - WRITE( IOUNIT, FMT = 9942 )5, 'N' - WRITE( IOUNIT, FMT = 9941 )6, 'N' - WRITE( IOUNIT, FMT = 9960 )7 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'QP' ) ) THEN -* -* QR decomposition with column pivoting -* - WRITE( IOUNIT, FMT = 9986 )PATH - WRITE( IOUNIT, FMT = 9969 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9940 )1 - WRITE( IOUNIT, FMT = 9939 )2 - WRITE( IOUNIT, FMT = 9938 )3 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'TZ' ) ) THEN -* -* TZ: Trapezoidal -* - WRITE( IOUNIT, FMT = 9985 )PATH - WRITE( IOUNIT, FMT = 9968 ) - WRITE( IOUNIT, FMT = 9929 )C1, C1 - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) - WRITE( IOUNIT, FMT = 9940 )1 - WRITE( IOUNIT, FMT = 9937 )2 - WRITE( IOUNIT, FMT = 9938 )3 - WRITE( IOUNIT, FMT = 9940 )4 - WRITE( IOUNIT, FMT = 9937 )5 - WRITE( IOUNIT, FMT = 9938 )6 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'LS' ) ) THEN -* -* LS: Least Squares driver routines for -* LS, LSD, LSS, LSX and LSY. -* - WRITE( IOUNIT, FMT = 9984 )PATH - WRITE( IOUNIT, FMT = 9967 ) - WRITE( IOUNIT, FMT = 9921 )C1, C1, C1, C1, C1 - WRITE( IOUNIT, FMT = 9935 )1 - WRITE( IOUNIT, FMT = 9931 )2 - WRITE( IOUNIT, FMT = 9933 )3 - WRITE( IOUNIT, FMT = 9935 )4 - WRITE( IOUNIT, FMT = 9934 )5 - WRITE( IOUNIT, FMT = 9932 )6 - WRITE( IOUNIT, FMT = 9920 ) - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'LU' ) ) THEN -* -* LU factorization variants -* - WRITE( IOUNIT, FMT = 9983 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9979 ) - WRITE( IOUNIT, FMT = '( '' Test ratio:'' )' ) - WRITE( IOUNIT, FMT = 9962 )1 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'CH' ) ) THEN -* -* Cholesky factorization variants -* - WRITE( IOUNIT, FMT = 9982 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9974 ) - WRITE( IOUNIT, FMT = '( '' Test ratio:'' )' ) - WRITE( IOUNIT, FMT = 9954 )1 - WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) -* - ELSE IF( LSAMEN( 2, P2, 'QS' ) ) THEN -* -* QR factorization variants -* - WRITE( IOUNIT, FMT = 9981 )PATH - WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) - WRITE( IOUNIT, FMT = 9970 ) - WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) -* - ELSE -* -* Print error message if no header is available. -* - WRITE( IOUNIT, FMT = 9980 )PATH - END IF -* -* First line of header -* - 9999 FORMAT( / 1X, A3, ': General dense matrices' ) - 9998 FORMAT( / 1X, A3, ': General band matrices' ) - 9997 FORMAT( / 1X, A3, ': General tridiagonal' ) - 9996 FORMAT( / 1X, A3, ': ', A9, ' positive definite matrices' ) - 9995 FORMAT( / 1X, A3, ': ', A9, ' positive definite packed matrices' - $ ) - 9994 FORMAT( / 1X, A3, ': ', A9, ' positive definite band matrices' ) - 9993 FORMAT( / 1X, A3, ': ', A9, ' positive definite tridiagonal' ) - 9992 FORMAT( / 1X, A3, ': ', A9, ' indefinite matrices' ) - 9991 FORMAT( / 1X, A3, ': ', A9, ' indefinite packed matrices' ) - 9990 FORMAT( / 1X, A3, ': Triangular matrices' ) - 9989 FORMAT( / 1X, A3, ': Triangular packed matrices' ) - 9988 FORMAT( / 1X, A3, ': Triangular band matrices' ) - 9987 FORMAT( / 1X, A3, ': ', A2, ' factorization of general matrices' - $ ) - 9986 FORMAT( / 1X, A3, ': QR factorization with column pivoting' ) - 9985 FORMAT( / 1X, A3, ': RQ factorization of trapezoidal matrix' ) - 9984 FORMAT( / 1X, A3, ': Least squares driver routines' ) - 9983 FORMAT( / 1X, A3, ': LU factorization variants' ) - 9982 FORMAT( / 1X, A3, ': Cholesky factorization variants' ) - 9981 FORMAT( / 1X, A3, ': QR factorization variants' ) - 9980 FORMAT( / 1X, A3, ': No header available' ) -* -* GE matrix types -* - 9979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X, - $ '2. Upper triangular', 16X, - $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS', - $ / 4X, '4. Random, CNDNUM = 2', 13X, - $ '10. Scaled near underflow', / 4X, '5. First column zero', - $ 14X, '11. Scaled near overflow', / 4X, - $ '6. Last column zero' ) -* -* GB matrix types -* - 9978 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, - $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. First column zero', 15X, '6. Random, CNDNUM = .01/EPS', - $ / 4X, '3. Last column zero', 16X, - $ '7. Scaled near underflow', / 4X, - $ '4. Last n/2 columns zero', 11X, '8. Scaled near overflow' ) -* -* GT matrix types -* - 9977 FORMAT( ' Matrix types (1-6 have specified condition numbers):', - $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', - $ / 4X, '2. Random, CNDNUM = 2', 14X, '8. First column zero', - $ / 4X, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, - $ '9. Last column zero', / 4X, '4. Random, CNDNUM = 0.1/EPS', - $ 7X, '10. Last n/2 columns zero', / 4X, - $ '5. Scaled near underflow', 10X, - $ '11. Scaled near underflow', / 4X, - $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) -* -* PT matrix types -* - 9976 FORMAT( ' Matrix types (1-6 have specified condition numbers):', - $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', - $ / 4X, '2. Random, CNDNUM = 2', 14X, - $ '8. First row and column zero', / 4X, - $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, - $ '9. Last row and column zero', / 4X, - $ '4. Random, CNDNUM = 0.1/EPS', 7X, - $ '10. Middle row and column zero', / 4X, - $ '5. Scaled near underflow', 10X, - $ '11. Scaled near underflow', / 4X, - $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) -* -* PO, PP matrix types -* - 9975 FORMAT( 4X, '1. Diagonal', 24X, - $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '7. Random, CNDNUM = 0.1/EPS', - $ / 3X, '*3. First row and column zero', 7X, - $ '8. Scaled near underflow', / 3X, - $ '*4. Last row and column zero', 8X, - $ '9. Scaled near overflow', / 3X, - $ '*5. Middle row and column zero', / 3X, - $ '(* - tests error exits from ', A3, - $ 'TRF, no test ratios are computed)' ) -* -* CH matrix types -* - 9974 FORMAT( 4X, '1. Diagonal', 24X, - $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '7. Random, CNDNUM = 0.1/EPS', - $ / 3X, '*3. First row and column zero', 7X, - $ '8. Scaled near underflow', / 3X, - $ '*4. Last row and column zero', 8X, - $ '9. Scaled near overflow', / 3X, - $ '*5. Middle row and column zero', / 3X, - $ '(* - tests error exits, no test ratios are computed)' ) -* -* PS matrix types -* - 8973 FORMAT( 4X, '1. Diagonal', / 4X, '2. Random, CNDNUM = 2', 14X, - $ / 3X, '*3. Nonzero eigenvalues of: D(1:RANK-1)=1 and ', - $ 'D(RANK) = 1.0/', A4, / 3X, - $ '*4. Nonzero eigenvalues of: D(1)=1 and ', - $ ' D(2:RANK) = 1.0/', A4, / 3X, - $ '*5. Nonzero eigenvalues of: D(I) = ', A4, - $ '**(-(I-1)/(RANK-1)) ', ' I=1:RANK', / 4X, - $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '7. Random, CNDNUM = 0.1/EPS', / 4X, - $ '8. Scaled near underflow', / 4X, '9. Scaled near overflow', - $ / 3X, '(* - Semi-definite tests )' ) - 8972 FORMAT( 3X, 'RANK minus computed rank, returned by ', A, 'PSTRF' ) -* -* PB matrix types -* - 9973 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, - $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3X, - $ '*2. First row and column zero', 7X, - $ '6. Random, CNDNUM = 0.1/EPS', / 3X, - $ '*3. Last row and column zero', 8X, - $ '7. Scaled near underflow', / 3X, - $ '*4. Middle row and column zero', 6X, - $ '8. Scaled near overflow', / 3X, - $ '(* - tests error exits from ', A3, - $ 'TRF, no test ratios are computed)' ) -* -* SSY, SSP, CHE, CHP matrix types -* - 9972 FORMAT( 4X, '1. Diagonal', 24X, - $ '6. Last n/2 rows and columns zero', / 4X, - $ '2. Random, CNDNUM = 2', 14X, - $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '3. First row and column zero', 7X, - $ '8. Random, CNDNUM = 0.1/EPS', / 4X, - $ '4. Last row and column zero', 8X, - $ '9. Scaled near underflow', / 4X, - $ '5. Middle row and column zero', 5X, - $ '10. Scaled near overflow' ) -* -* CSY, CSP matrix types -* - 9971 FORMAT( 4X, '1. Diagonal', 24X, - $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '8. Random, CNDNUM = 0.1/EPS', - $ / 4X, '3. First row and column zero', 7X, - $ '9. Scaled near underflow', / 4X, - $ '4. Last row and column zero', 7X, - $ '10. Scaled near overflow', / 4X, - $ '5. Middle row and column zero', 5X, - $ '11. Block diagonal matrix', / 4X, - $ '6. Last n/2 rows and columns zero' ) -* -* QR matrix types -* - 9970 FORMAT( 4X, '1. Diagonal', 24X, - $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '2. Upper triangular', 16X, '6. Random, CNDNUM = 0.1/EPS', - $ / 4X, '3. Lower triangular', 16X, - $ '7. Scaled near underflow', / 4X, '4. Random, CNDNUM = 2', - $ 14X, '8. Scaled near overflow' ) -* -* QP matrix types -* - 9969 FORMAT( ' Matrix types (2-6 have condition 1/EPS):', / 4X, - $ '1. Zero matrix', 21X, '4. First n/2 columns fixed', / 4X, - $ '2. One small eigenvalue', 12X, '5. Last n/2 columns fixed', - $ / 4X, '3. Geometric distribution', 10X, - $ '6. Every second column fixed' ) -* -* TZ matrix types -* - 9968 FORMAT( ' Matrix types (2-3 have condition 1/EPS):', / 4X, - $ '1. Zero matrix', / 4X, '2. One small eigenvalue', / 4X, - $ '3. Geometric distribution' ) -* -* LS matrix types -* - 9967 FORMAT( ' Matrix types (1-3: full rank, 4-6: rank deficient):', - $ / 4X, '1 and 4. Normal scaling', / 4X, - $ '2 and 5. Scaled near overflow', / 4X, - $ '3 and 6. Scaled near underflow' ) -* -* TR, TP matrix types -* - 9966 FORMAT( ' Matrix types for ', A3, ' routines:', / 4X, - $ '1. Diagonal', 24X, '6. Scaled near overflow', / 4X, - $ '2. Random, CNDNUM = 2', 14X, '7. Identity', / 4X, - $ '3. Random, CNDNUM = sqrt(0.1/EPS) ', - $ '8. Unit triangular, CNDNUM = 2', / 4X, - $ '4. Random, CNDNUM = 0.1/EPS', 8X, - $ '9. Unit, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '5. Scaled near underflow', 10X, - $ '10. Unit, CNDNUM = 0.1/EPS' ) - 9965 FORMAT( ' Special types for testing ', A, ':', / 3X, - $ '11. Matrix elements are O(1), large right hand side', / 3X, - $ '12. First diagonal causes overflow,', - $ ' offdiagonal column norms < 1', / 3X, - $ '13. First diagonal causes overflow,', - $ ' offdiagonal column norms > 1', / 3X, - $ '14. Growth factor underflows, solution does not overflow', - $ / 3X, '15. Small diagonal causes gradual overflow', / 3X, - $ '16. One zero diagonal element', / 3X, - $ '17. Large offdiagonals cause overflow when adding a column' - $ , / 3X, '18. Unit triangular with large right hand side' ) -* -* TB matrix types -* - 9964 FORMAT( ' Matrix types for ', A3, ' routines:', / 4X, - $ '1. Random, CNDNUM = 2', 14X, '6. Identity', / 4X, - $ '2. Random, CNDNUM = sqrt(0.1/EPS) ', - $ '7. Unit triangular, CNDNUM = 2', / 4X, - $ '3. Random, CNDNUM = 0.1/EPS', 8X, - $ '8. Unit, CNDNUM = sqrt(0.1/EPS)', / 4X, - $ '4. Scaled near underflow', 11X, - $ '9. Unit, CNDNUM = 0.1/EPS', / 4X, - $ '5. Scaled near overflow' ) - 9963 FORMAT( ' Special types for testing ', A, ':', / 3X, - $ '10. Matrix elements are O(1), large right hand side', / 3X, - $ '11. First diagonal causes overflow,', - $ ' offdiagonal column norms < 1', / 3X, - $ '12. First diagonal causes overflow,', - $ ' offdiagonal column norms > 1', / 3X, - $ '13. Growth factor underflows, solution does not overflow', - $ / 3X, '14. Small diagonal causes gradual overflow', / 3X, - $ '15. One zero diagonal element', / 3X, - $ '16. Large offdiagonals cause overflow when adding a column' - $ , / 3X, '17. Unit triangular with large right hand side' ) -* -* Test ratios -* - 9962 FORMAT( 3X, I2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' ) - 9961 FORMAT( 3X, I2, ': norm( I - A*AINV ) / ', - $ '( N * norm(A) * norm(AINV) * EPS )' ) - 9960 FORMAT( 3X, I2, ': norm( B - A * X ) / ', - $ '( norm(A) * norm(X) * EPS )' ) - 6660 FORMAT( 3X, I2, ': diagonal is not non-negative') - 9959 FORMAT( 3X, I2, ': norm( X - XACT ) / ', - $ '( norm(XACT) * CNDNUM * EPS )' ) - 9958 FORMAT( 3X, I2, ': norm( X - XACT ) / ', - $ '( norm(XACT) * CNDNUM * EPS ), refined' ) - 9957 FORMAT( 3X, I2, ': norm( X - XACT ) / ', - $ '( norm(XACT) * (error bound) )' ) - 9956 FORMAT( 3X, I2, ': (backward error) / EPS' ) - 9955 FORMAT( 3X, I2, ': RCOND * CNDNUM - 1.0' ) - 9954 FORMAT( 3X, I2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 8950 FORMAT( 3X, - $ 'norm( P * U'' * U * P'' - A ) / ( N * norm(A) * EPS )', - $ ', or', / 3X, - $ 'norm( P * L * L'' * P'' - A ) / ( N * norm(A) * EPS )' ) - 9953 FORMAT( 3X, I2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 9952 FORMAT( 3X, I2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )', - $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' - $ ) - 9951 FORMAT( ' Test ratio for ', A, ':', / 3X, I2, - $ ': norm( s*b - A*x ) / ( norm(A) * norm(x) * EPS )' ) - 9950 FORMAT( 3X, I2, ': norm( R - Q'' * A ) / ( M * norm(A) * EPS )' ) - 9949 FORMAT( 3X, I2, ': norm( L - A * Q'' ) / ( N * norm(A) * EPS )' ) - 9948 FORMAT( 3X, I2, ': norm( L - Q'' * A ) / ( M * norm(A) * EPS )' ) - 9947 FORMAT( 3X, I2, ': norm( R - A * Q'' ) / ( N * norm(A) * EPS )' ) - 9946 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( M * EPS )' ) - 9945 FORMAT( 3X, I2, ': norm( I - Q*Q'' ) / ( N * EPS )' ) - 9944 FORMAT( 3X, I2, ': norm( Q*C - Q*C ) / ', '( ', A1, - $ ' * norm(C) * EPS )' ) - 9943 FORMAT( 3X, I2, ': norm( C*Q - C*Q ) / ', '( ', A1, - $ ' * norm(C) * EPS )' ) - 9942 FORMAT( 3X, I2, ': norm( Q''*C - Q''*C )/ ', '( ', A1, - $ ' * norm(C) * EPS )' ) - 9941 FORMAT( 3X, I2, ': norm( C*Q'' - C*Q'' )/ ', '( ', A1, - $ ' * norm(C) * EPS )' ) - 9940 FORMAT( 3X, I2, ': norm(svd(A) - svd(R)) / ', - $ '( M * norm(svd(R)) * EPS )' ) - 9939 FORMAT( 3X, I2, ': norm( A*P - Q*R ) / ( M * norm(A) * EPS )' - $ ) - 9938 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( M * EPS )' ) - 9937 FORMAT( 3X, I2, ': norm( A - R*Q ) / ( M * norm(A) * EPS )' - $ ) - 9936 FORMAT( ' Test ratios (1-2: ', A1, 'GELS, 3-6: ', A1, - $ 'GELSS, 7-10: ', A1, 'GELSX):' ) - 9935 FORMAT( 3X, I2, ': norm( B - A * X ) / ', - $ '( max(M,N) * norm(A) * norm(X) * EPS )' ) - 9934 FORMAT( 3X, I2, ': norm( (A*X-B)'' *A ) / ', - $ '( max(M,N,NRHS) * norm(A) * norm(B) * EPS )' ) - 9933 FORMAT( 3X, I2, ': norm(svd(A)-svd(R)) / ', - $ '( min(M,N) * norm(svd(R)) * EPS )' ) - 9932 FORMAT( 3X, I2, ': Check if X is in the row space of A or A''' ) - 9931 FORMAT( 3X, I2, ': norm( (A*X-B)'' *A ) / ', - $ '( max(M,N,NRHS) * norm(A) * norm(B) * EPS )', / 7X, - $ 'if TRANS=''N'' and M.GE.N or TRANS=''T'' and M.LT.N, ', - $ 'otherwise', / 7X, - $ 'check if X is in the row space of A or A'' ', - $ '(overdetermined case)' ) - 9930 FORMAT( 3X, ' 7-10: same as 3-6' ) - 9929 FORMAT( ' Test ratios (1-3: ', A1, 'TZRQF, 4-6: ', A1, - $ 'TZRZF):' ) - 9920 FORMAT( 3X, ' 7-10: same as 3-6', 3X, ' 11-14: same as 3-6', - $ 3X, ' 15-18: same as 3-6' ) - 9921 FORMAT( ' Test ratios:', / ' (1-2: ', A1, 'GELS, 3-6: ', A1, - $ 'GELSX, 7-10: ', A1, 'GELSY, 11-14: ', A1, 'GELSS, 15-18: ', - $ A1, 'GELSD)' ) -* - RETURN -* -* End of ALAHD -* - END diff --git a/testing/lin/alareq.f b/testing/lin/alareq.f deleted file mode 100644 index 44a1a23192613ca29c2e6dd42ab2943ea1102cbf..0000000000000000000000000000000000000000 --- a/testing/lin/alareq.f +++ /dev/null @@ -1,202 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NIN, NMATS, NOUT, NTYPES -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) -* .. -* -* Purpose -* ======= -* -* ALAREQ handles input for the LAPACK test program. It is called -* to evaluate the input line which requested NMATS matrix types for -* PATH. The flow of control is as follows: -* -* If NMATS = NTYPES then -* DOTYPE(1:NTYPES) = .TRUE. -* else -* Read the next input line for NMATS matrix types -* Set DOTYPE(I) = .TRUE. for each valid type I -* endif -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* An LAPACK path name for testing. -* -* NMATS (input) INTEGER -* The number of matrix types to be used in testing this path. -* -* DOTYPE (output) LOGICAL array, dimension (NTYPES) -* The vector of flags indicating if each type will be tested. -* -* NTYPES (input) INTEGER -* The maximum number of matrix types for this path. -* -* NIN (input) INTEGER -* The unit number for input. NIN >= 1. -* -* NOUT (input) INTEGER -* The unit number for output. NOUT >= 1. -* -* ===================================================================== -* -* .. Local Scalars .. - LOGICAL FIRSTT - CHARACTER C1 - CHARACTER*10 INTSTR - CHARACTER*80 LINE - INTEGER I, I1, IC, J, K, LENP, NT -* .. -* .. Local Arrays .. - INTEGER NREQ( 100 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC LEN -* .. -* .. Data statements .. - DATA INTSTR / '0123456789' / -* .. -* .. Executable Statements .. -* - IF( NMATS.GE.NTYPES ) THEN -* -* Test everything if NMATS >= NTYPES. -* - DO 10 I = 1, NTYPES - DOTYPE( I ) = .TRUE. - 10 CONTINUE - ELSE - DO 20 I = 1, NTYPES - DOTYPE( I ) = .FALSE. - 20 CONTINUE - FIRSTT = .TRUE. -* -* Read a line of matrix types if 0 < NMATS < NTYPES. -* - IF( NMATS.GT.0 ) THEN - READ( NIN, FMT = '(A80)', END = 90 )LINE - LENP = LEN( LINE ) - I = 0 - DO 60 J = 1, NMATS - NREQ( J ) = 0 - I1 = 0 - 30 CONTINUE - I = I + 1 - IF( I.GT.LENP ) THEN - IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN - GO TO 60 - ELSE - WRITE( NOUT, FMT = 9995 )LINE - WRITE( NOUT, FMT = 9994 )NMATS - GO TO 80 - END IF - END IF - IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN - I1 = I - C1 = LINE( I1: I1 ) -* -* Check that a valid integer was read -* - DO 40 K = 1, 10 - IF( C1.EQ.INTSTR( K: K ) ) THEN - IC = K - 1 - GO TO 50 - END IF - 40 CONTINUE - WRITE( NOUT, FMT = 9996 )I, LINE - WRITE( NOUT, FMT = 9994 )NMATS - GO TO 80 - 50 CONTINUE - NREQ( J ) = 10*NREQ( J ) + IC - GO TO 30 - ELSE IF( I1.GT.0 ) THEN - GO TO 60 - ELSE - GO TO 30 - END IF - 60 CONTINUE - END IF - DO 70 I = 1, NMATS - NT = NREQ( I ) - IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN - IF( DOTYPE( NT ) ) THEN - IF( FIRSTT ) - $ WRITE( NOUT, FMT = * ) - FIRSTT = .FALSE. - WRITE( NOUT, FMT = 9997 )NT, PATH - END IF - DOTYPE( NT ) = .TRUE. - ELSE - WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES - 9999 FORMAT( ' *** Invalid type request for ', A3, ', type ', - $ I4, ': must satisfy 1 <= type <= ', I2 ) - END IF - 70 CONTINUE - 80 CONTINUE - END IF - RETURN -* - 90 CONTINUE - WRITE( NOUT, FMT = 9998 )PATH - 9998 FORMAT( /' *** End of file reached when trying to read matrix ', - $ 'types for ', A3, /' *** Check that you are requesting the', - $ ' right number of types for each path', / ) - 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', I2, - $ ' for ', A3 ) - 9996 FORMAT( //' *** Invalid integer value in column ', I2, - $ ' of input', ' line:', /A79 ) - 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 ) - 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ', - $ 'adjust NTYPES on previous line' ) - WRITE( NOUT, FMT = * ) - STOP -* -* End of ALAREQ -* - END diff --git a/testing/lin/alasum.f b/testing/lin/alasum.f deleted file mode 100644 index 9155a3f6581e6b930e6947e9afa69e22da69c06b..0000000000000000000000000000000000000000 --- a/testing/lin/alasum.f +++ /dev/null @@ -1,95 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALASUM( TYPE, NOUT, NFAIL, NRUN, NERRS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 TYPE - INTEGER NFAIL, NOUT, NRUN, NERRS -* .. -* -* Purpose -* ======= -* -* ALASUM prints a summary of results from one of the -CHK- routines. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*3 -* The LAPACK path name. -* -* NOUT (input) INTEGER -* The unit number on which results are to be printed. -* NOUT >= 0. -* -* NFAIL (input) INTEGER -* The number of tests which did not pass the threshold ratio. -* -* NRUN (input) INTEGER -* The total number of tests. -* -* NERRS (input) INTEGER -* The number of error messages recorded. -* -* ===================================================================== -* -* .. Executable Statements .. -* - IF( NFAIL.GT.0 ) THEN - WRITE( NOUT, FMT = 9999 )TYPE, NFAIL, NRUN - ELSE - WRITE( NOUT, FMT = 9998 )TYPE, NRUN - END IF - IF( NERRS.GT.0 ) THEN - WRITE( NOUT, FMT = 9997 )NERRS - END IF -* - 9999 FORMAT( 1X, A3, ': ', I6, ' out of ', I6, - $ ' tests failed to pass the threshold' ) - 9998 FORMAT( /1X, 'All tests for ', A3, - $ ' routines passed the threshold (', I6, ' tests run)' ) - 9997 FORMAT( 6X, I6, ' error messages recorded' ) - RETURN -* -* End of ALASUM -* - END diff --git a/testing/lin/alasvm.f b/testing/lin/alasvm.f deleted file mode 100644 index 822cb54eca3edfe4ac4b2a5cb97e9ddd87bb092c..0000000000000000000000000000000000000000 --- a/testing/lin/alasvm.f +++ /dev/null @@ -1,95 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ALASVM( TYPE, NOUT, NFAIL, NRUN, NERRS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 TYPE - INTEGER NFAIL, NOUT, NRUN, NERRS -* .. -* -* Purpose -* ======= -* -* ALASVM prints a summary of results from one of the -DRV- routines. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*3 -* The LAPACK path name. -* -* NOUT (input) INTEGER -* The unit number on which results are to be printed. -* NOUT >= 0. -* -* NFAIL (input) INTEGER -* The number of tests which did not pass the threshold ratio. -* -* NRUN (input) INTEGER -* The total number of tests. -* -* NERRS (input) INTEGER -* The number of error messages recorded. -* -* ===================================================================== -* -* .. Executable Statements .. -* - IF( NFAIL.GT.0 ) THEN - WRITE( NOUT, FMT = 9999 )TYPE, NFAIL, NRUN - ELSE - WRITE( NOUT, FMT = 9998 )TYPE, NRUN - END IF - IF( NERRS.GT.0 ) THEN - WRITE( NOUT, FMT = 9997 )NERRS - END IF -* - 9999 FORMAT( 1X, A3, ' drivers: ', I6, ' out of ', I6, - $ ' tests failed to pass the threshold' ) - 9998 FORMAT( /1X, 'All tests for ', A3, ' drivers passed the ', - $ 'threshold (', I6, ' tests run)' ) - 9997 FORMAT( 14X, I6, ' error messages recorded' ) - RETURN -* -* End of ALASVM -* - END diff --git a/testing/lin/cchkaa.f b/testing/lin/cchkaa.f deleted file mode 100644 index df530ab01e50860f11f17d6f1fe6fda82d764ddd..0000000000000000000000000000000000000000 --- a/testing/lin/cchkaa.f +++ /dev/null @@ -1,636 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - PROGRAM CCHKAA -* - INCLUDE 'chameleon_fortran.h' -* -* -- CHAMELEON test routine (From LAPACK version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* Purpose -* ======= -* -* CCHKAA is the main test program for the COMPLEX linear equation -* routines. -* -* The program must be driven by a short data file. The first 14 records -* specify problem dimensions and program options using list-directed -* input. The remaining lines specify the CHAMELEON test paths and the -* number of matrix types to use in testing. An annotated example of a -* data file can be obtained by deleting the first 3 characters from the -* following 38 lines: -* Data file for testing COMPLEX CHAMELEON linear equation routines -* 1 Number of values of NP -* 16 Values of NP (number of cores) -* 1 Values of SCHED (0: STATIC, 1:DYNAMIC) -* 7 Number of values of M -* 0 1 2 3 5 10 16 Values of M (row dimension) -* 7 Number of values of N -* 0 1 2 3 5 10 16 Values of N (column dimension) -* 1 Number of values of NRHS -* 2 Values of NRHS (number of right hand sides) -* 5 Number of values of NB -* 1 3 3 3 20 Values of NB (the blocksize) -* 1 0 5 9 1 Values of NX (crossover point) -* 3 Number of values of RANK -* 30 50 90 Values of rank (as a % of N) -* 30.0 Threshold value of test ratio -* T Put T to test the CHAMELEON routines -* T Put T to test the driver routines -* T Put T to test the error exits -* CGE 11 List types on next line if 0 < NTYPES < 11 -* CGB 8 List types on next line if 0 < NTYPES < 8 -* CGT 12 List types on next line if 0 < NTYPES < 12 -* CPO 9 List types on next line if 0 < NTYPES < 9 -* CPO 9 List types on next line if 0 < NTYPES < 9 -* CPP 9 List types on next line if 0 < NTYPES < 9 -* CPB 8 List types on next line if 0 < NTYPES < 8 -* CPT 12 List types on next line if 0 < NTYPES < 12 -* CHE 10 List types on next line if 0 < NTYPES < 10 -* CHP 10 List types on next line if 0 < NTYPES < 10 -* CSY 11 List types on next line if 0 < NTYPES < 11 -* CSP 11 List types on next line if 0 < NTYPES < 11 -* CTR 18 List types on next line if 0 < NTYPES < 18 -* CTP 18 List types on next line if 0 < NTYPES < 18 -* CTB 17 List types on next line if 0 < NTYPES < 17 -* CQR 8 List types on next line if 0 < NTYPES < 8 -* CRQ 8 List types on next line if 0 < NTYPES < 8 -* CLQ 8 List types on next line if 0 < NTYPES < 8 -* CQL 8 List types on next line if 0 < NTYPES < 8 -* CQP 6 List types on next line if 0 < NTYPES < 6 -* CTZ 3 List types on next line if 0 < NTYPES < 3 -* CLS 6 List types on next line if 0 < NTYPES < 6 -* CEQ -* -* Internal Parameters -* =================== -* -* NMAX INTEGER -* The maximum allowable value for N. -* -* MAXIN INTEGER -* The number of different values that can be used for each of -* M, N, or NB -* -* MAXRHS INTEGER -* The maximum number of right hand sides -* -* NIN INTEGER -* The unit number for input -* -* NOUT INTEGER -* The unit number for output -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NPMAX - PARAMETER ( NPMAX = 16 ) - INTEGER NMAX - PARAMETER ( NMAX = 1000 ) - INTEGER MAXIN - PARAMETER ( MAXIN = 12 ) - INTEGER MAXRHS - PARAMETER ( MAXRHS = 16 ) - INTEGER MATMAX - PARAMETER ( MATMAX = 30 ) - INTEGER NIN, NOUT - PARAMETER ( NIN = 5, NOUT = 6 ) - INTEGER KDMAX - PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) -* .. -* .. Local Scalars .. - LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR - CHARACTER C1 - CHARACTER*2 C2 - CHARACTER*3 PATH - CHARACTER*10 INTSTR - CHARACTER*72 ALINE - INTEGER I, IC, J, K, LDA, NB, NM, NMATS, - $ NN, NNB, NNB2, NNS, NNP, SCHED, NRHS, NTYPES, - $ VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO - REAL EPS, THREQ, THRESH -* .. -* .. Local Arrays .. - LOGICAL DOTYPE( MATMAX ) - INTEGER IBVAL(MAXIN), IWORK( 25*NMAX ), MVAL( MAXIN ), - $ NBVAL( MAXIN ), NBVAL2( MAXIN ), - $ NPVAL(MAXIN), NSVAL( MAXIN ), - $ NVAL( MAXIN ), NXVAL( MAXIN ), - $ RANKVAL( MAXIN ) - REAL RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX ) - COMPLEX A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), - $ WORK( NMAX, NMAX+MAXRHS+10 ) -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - REAL SECOND, SLAMCH - EXTERNAL LSAME, LSAMEN, SECOND, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL ALAREQ, CCHKGE, - $ CCHKLQ, CCHKPO, - $ CCHKQR, - $ CDRVLS, - $ CDRVPO, - $ ILAVER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Arrays in Common .. - INTEGER IPARMS( 100 ) -* .. -* .. Common blocks .. - COMMON / CLAENV / IPARMS - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA THREQ / 2.0 / , INTSTR / '0123456789' / -* .. -* .. Executable Statements .. -* -* S1 = SECOND( ) - LDA = NMAX - FATAL = .FALSE. -* -* Report values of parameters version. -* - CALL CHAMELEON_VERSION( VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO) - WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH -* -* Read a dummy line. -* - READ( NIN, FMT = * ) -* -* Read the values of NP -* - READ( NIN, FMT = * )NNP - IF( NNP.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNP ', NNP, 1 - NNP = 0 - FATAL = .TRUE. - ELSE IF( NNP.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNP ', NNP, MAXIN - NNP = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NPVAL( I ), I = 1, NNP ) - DO 01 I = 1, NNP - IF( NPVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NP ', NPVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NPVAL( I ).GT.NPMAX ) THEN - WRITE( NOUT, FMT = 9995 )' NP ', NPVAL( I ), NPMAX - FATAL = .TRUE. - END IF - 01 CONTINUE - IF( NNP.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NP ', ( NPVAL( I ), I = 1, NNP ) -* -* Read the values of SCHED -* - READ( NIN, FMT = * )SCHED - IF (( SCHED .LT. 0 ) .OR. (SCHED .GT. 1)) THEN - WRITE( NOUT, FMT = 9987 )' SCHED ', SCHED - SCHED = 0 - FATAL = .TRUE. - END IF -* -* Read the values of M -* - READ( NIN, FMT = * )NM - IF( NM.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 - NM = 0 - FATAL = .TRUE. - ELSE IF( NM.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN - NM = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) - DO 10 I = 1, NM - IF( MVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( MVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX - FATAL = .TRUE. - END IF - 10 CONTINUE - IF( NM.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) -* -* Read the values of N -* - READ( NIN, FMT = * )NN - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 - NN = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN - NN = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) - DO 20 I = 1, NN - IF( NVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX - FATAL = .TRUE. - END IF - 20 CONTINUE - IF( NN.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) -* -* Read the values of NRHS -* - READ( NIN, FMT = * )NNS - IF( NNS.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 - NNS = 0 - FATAL = .TRUE. - ELSE IF( NNS.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN - NNS = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) - DO 30 I = 1, NNS - IF( NSVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN - WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS - FATAL = .TRUE. - END IF - 30 CONTINUE - IF( NNS.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) -* -* Read the values of NB -* - READ( NIN, FMT = * )NNB - IF( NNB.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 - NNB = 0 - FATAL = .TRUE. - ELSE IF( NNB.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN - NNB = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) - DO 40 I = 1, NNB - IF( NBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 - FATAL = .TRUE. - END IF - 40 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) -* -* Read the values of IB -* - READ( NIN, FMT = * )( IBVAL( I ), I = 1, NNB ) - DO 41 I = 1, NNB - IF( IBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', IBVAL( I ), 0 - FATAL = .TRUE. - END IF - 41 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'IB ', ( IBVAL( I ), I = 1, NNB ) -* -* Set NBVAL2 to be the set of unique values of NB -* - NNB2 = 0 - DO 60 I = 1, NNB - NB = NBVAL( I ) - DO 50 J = 1, NNB2 - IF( NB.EQ.NBVAL2( J ) ) - $ GO TO 60 - 50 CONTINUE - NNB2 = NNB2 + 1 - NBVAL2( NNB2 ) = NB - 60 CONTINUE -* -* Read the values of NX -* - READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) - DO 70 I = 1, NNB - IF( NXVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 - FATAL = .TRUE. - END IF - 70 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) -* -* Read the values of RANKVAL -* - READ( NIN, FMT = * )NRANK - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 - NRANK = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN - NRANK = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) - DO I = 1, NRANK - IF( RANKVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( RANKVAL( I ).GT.100 ) THEN - WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 - FATAL = .TRUE. - END IF - END DO - IF( NRANK.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', - $ ( RANKVAL( I ), I = 1, NRANK ) -* -* Read the threshold value for the test ratios. -* - READ( NIN, FMT = * )THRESH - WRITE( NOUT, FMT = 9992 )THRESH -* -* Read the flag that indicates whether to test the CHAMELEON routines. -* - READ( NIN, FMT = * )TSTCHK -* -* Read the flag that indicates whether to test the driver routines. -* - READ( NIN, FMT = * )TSTDRV -* -* Read the flag that indicates whether to test the error exits. -* - READ( NIN, FMT = * )TSTERR -* - IF( FATAL ) THEN - WRITE( NOUT, FMT = 9999 ) - STOP - END IF -* -* Calculate and print the machine dependent constants. -* - EPS = SLAMCH( 'Underflow threshold' ) - WRITE( NOUT, FMT = 9991 )'underflow', EPS - EPS = SLAMCH( 'Overflow threshold' ) - WRITE( NOUT, FMT = 9991 )'overflow ', EPS - EPS = SLAMCH( 'Epsilon' ) - WRITE( NOUT, FMT = 9991 )'precision', EPS - WRITE( NOUT, FMT = * ) - NRHS = NSVAL( 1 ) -* -* Initialize CHAMELEON -* - CALL CHAMELEON_INIT( NPVAL(NNP), INFO ) -* - IF( SCHED .EQ. 1 ) THEN - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_DYNAMIC_SCHEDULING, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_STATIC_SCHEDULING, INFO ) - ENDIF -* - CALL CHAMELEON_DISABLE( CHAMELEON_AUTOTUNING, INFO ) -* - 80 CONTINUE -* -* Read a test path and the number of matrix types to use. -* - READ( NIN, FMT = '(A72)', END = 140 )ALINE - PATH = ALINE( 1: 3 ) - NMATS = MATMAX - I = 3 - 90 CONTINUE - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - IF( ALINE( I: I ).EQ.' ' ) - $ GO TO 90 - NMATS = 0 - 100 CONTINUE - C1 = ALINE( I: I ) - DO 110 K = 1, 10 - IF( C1.EQ.INTSTR( K: K ) ) THEN - IC = K - 1 - GO TO 120 - END IF - 110 CONTINUE - GO TO 130 - 120 CONTINUE - NMATS = NMATS*10 + IC - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - GO TO 100 - 130 CONTINUE - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) -* -* -* Check first character for correct precision. -* - IF( .NOT.LSAME( C1, 'Complex precision' ) ) THEN - WRITE( NOUT, FMT = 9990 )PATH -* - ELSE IF( NMATS.LE.0 ) THEN -* -* Check for a positive number of tests requested. -* - WRITE( NOUT, FMT = 9989 )PATH -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* GE: general matrices -* - NTYPES = 11 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL CCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), - $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL CDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* PO: positive definite matrices -* - NTYPES = 9 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL CCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, - $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), - $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ WORK, RWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL CDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN -* -* QR: QR factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL CCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN -* -* LQ: LQ factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL CCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* LS: Least squares drivers -* - NTYPES = 6 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTDRV ) THEN - CALL CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ IBVAL, NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ S( 1 ), S( NMAX+1 ), WORK, RWORK, IWORK, - $ NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE -* - WRITE( NOUT, FMT = 9990 )PATH - END IF -* -* Go back to get another input line. -* - GO TO 80 -* -* Branch to this line when the last record is read. -* - 140 CONTINUE - CLOSE ( NIN ) -* -* Finalize CHAMELEON -* - CALL CHAMELEON_FINALIZE( INFO ) -* -* S2 = SECOND( ) - WRITE( NOUT, FMT = 9998 ) -* WRITE( NOUT, FMT = 9997 )S2 - S1 -* - 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / ' End of tests' ) -C 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) - 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', - $ I6 ) - 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', - $ I6 ) - 9994 FORMAT( ' Tests of the COMPLEX CHAMELEON routines ', - $ / ' CHAMELEON VERSION ', I1, '.', I1, '.', I1, - $ / / ' The following parameter values will be used:' ) - 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) - 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', - $ 'less than', F8.2, / ) - 9991 FORMAT( ' Relative machine ', A, ' is taken to be', E16.6 ) - 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) - 9989 FORMAT( / 1X, A3, ' routines were not tested' ) - 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) - 9987 FORMAT( ' Invalid input value: ', A6, '=', I6, '; must be 0 or 1') -* -* End of CCHKAA -* - END diff --git a/testing/lin/cchkge.f b/testing/lin/cchkge.f deleted file mode 100644 index 786277580b23575581e9e8b53bc3a94a1e3b0e95..0000000000000000000000000000000000000000 --- a/testing/lin/cchkge.f +++ /dev/null @@ -1,460 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, - $ AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ IBVAL( * ), NVAL( * ) - REAL RWORK( * ) - COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), - $ WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CCHKGE tests CGETRF, -TRI, -TRS, -RFS, and -CON. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AINV (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* -* WORK (workspace) COMPLEX array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) REAL array, dimension -* (max(2*NMAX,2*NSMAX+NWORK)) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) - INTEGER NTRAN -* ONLY NOTRANS SUPPORTED !!! - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL TRFCON, ZEROT - CHARACTER DIST, NORM, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN, - $ IZERO, K, KL, KU, LDA, LWORK, M, MODE, N, NB, - $ NERRS, NFAIL, NIMAT, NRHS, NRUN, NT, IB, - $ CHAMELEON_TRANS - REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY, - $ RCOND, RCONDC, RCONDI, RCONDO -c$$$ INTEGER HL( 2 ), HPIV( 2 ) -* .. -* .. Local Arrays .. - CHARACTER TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL CLANGE, SGET06 - EXTERNAL CLANGE, SGET06 -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRGE, CGECON, CGERFS, - $ CGET02, CGET04, CGETRF, - $ CGETRI, CGETRS, CLACPY, CLARHS, CLASET, CLATB4, - $ CLATMS, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / , -* $ TRANSS / 'N', 'T', 'C' / - $ TRANSS / 'N' / - $ CHAMELEON_TRANSS / CHAMELEONNOTRANS / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - CALL XLAENV( 1, 1 ) - IF( TSTERR ) - $ CALL CERRGE( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of M in MVAL -* - DO 120 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* -* Do for each value of N in NVAL -* - DO 110 IN = 1, NN - N = NVAL( IN ) - XTYPE = 'N' - NIMAT = NTYPES - IF( M.LE.0 .OR. N.LE.0 ) - $ NIMAT = 1 -* - DO 100 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 100 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 100 -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'CLATMS' - CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = MIN( M, N ) - ELSE - IZERO = MIN( M, N ) / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, M - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL CLASET( 'Full', M, N-IZERO+1, CMPLX( ZERO ), - $ CMPLX( ZERO ), A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* These lines, if used in place of the calls in the DO 60 -* loop, cause the code to bomb on a Sun SPARCstation. -* -* ANORMO = CLANGE( 'O', M, N, A, LDA, RWORK ) -* ANORMI = CLANGE( 'I', M, N, A, LDA, RWORK ) -* -* Do for each blocksize in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IB = IBVAL( INB ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* ALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_CGETRF_INCPIV( -c$$$ $ M, N, HL, HPIV, INFO ) -* -* Compute the LU factorization of the matrix. -* - CALL CLACPY( 'Full', M, N, A, LDA, AFAC, LDA ) - SRNAMT = 'CGETRF' -c$$$ CALL CHAMELEON_CGETRF_INCPIV( M, N, AFAC, LDA, HL, -c$$$ $ HPIV, INFO ) - CALL CHAMELEON_CGETRF( M, N, AFAC, LDA, - $ IWORK, INFO ) -* -* Check error code from CGETRF. -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'CGETRF', INFO, IZERO, ' ', M, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - TRFCON = .FALSE. - NT = 0 -* - IF( M.NE.N .OR. INFO.GT.0 ) THEN -* -* Do only the condition estimate if INFO > 0. -* - TRFCON = .TRUE. - ANORMO = CLANGE( 'O', M, N, A, LDA, RWORK ) - ANORMI = CLANGE( 'I', M, N, A, LDA, RWORK ) - RCONDO = ZERO - RCONDI = ZERO - END IF -* -* Print information about the tests so far that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT -* -* Skip the remaining tests if this is not the first -* block size or if M .ne. N. Skip the solve tests if -* the matrix is singular. -* -* IF( INB.GT.1 .OR. M.NE.N ) -* $ GO TO 90 - IF( TRFCON ) - $ GO TO 70 -* - DO 60 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) - XTYPE = 'N' -* - DO 50 ITRAN = 1, NTRAN - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -*+ TEST 3 -* Solve and compute residual for A * X = B. -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, - $ LDA, ISEED, INFO ) - XTYPE = 'C' -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) - SRNAMT = 'CGETRS' -c$$$ CALL CHAMELEON_CGETRS_INCPIV( CHAMELEON_TRANS, N, -c$$$ $ NRHS, AFAC, LDA, HL, HPIV, -c$$$ $ X, LDA, INFO ) - CALL CHAMELEON_CGETRS( CHAMELEON_TRANS, N, - $ NRHS, AFAC, LDA, IWORK, - $ X, LDA, INFO ) -* -* Check error code from CGETRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CGETRS', INFO, 0, TRANS, - $ N, N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL CGET02( TRANS, N, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -* Print information about the tests that did not -* pass the threshold. -* - DO 40 K = 3, 4 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )TRANS, N, NB, - $ NRHS, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 40 CONTINUE - NRUN = NRUN + 2 - 50 CONTINUE - 60 CONTINUE -* - 70 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE - 100 CONTINUE -* - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M = ', I5, ', N =', I5, ', NB =', I4, ', type ', I2, - $ ', test(', I2, ') =', G12.5 ) - 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NB =', I4, ', - $NRHS=', I3, ', type ', I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of CCHKGE -* - END diff --git a/testing/lin/cchklq.f b/testing/lin/cchklq.f deleted file mode 100644 index 0b374ffa59af2b2e28dda03083cd4b16cb5b6499..0000000000000000000000000000000000000000 --- a/testing/lin/cchklq.f +++ /dev/null @@ -1,415 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AL, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - REAL RWORK( * ) - COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), - $ B( * ), TAU( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CCHKLQ tests CGELQF, CUNGLQ and CUNMLQ. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AF (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AQ (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AL (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* TAU (workspace) COMPLEX array, dimension (NMAX) -* -* WORK (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* RWORK (workspace) REAL array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - REAL ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - REAL RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL CGENND - EXTERNAL CGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGET02, - $ CLACPY, CLARHS, CLATB4, CLATMS, CLQT01, CLQT02, - $ CLQT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'LQ' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL CERRLQ( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( N.LT.M ) - $ GO TO 60 - MINMN = MIN( M, N ) - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'CLATMS' - CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of CLQT01; other values are -* used in the calls of CLQT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGELQF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test CGELQF -* - CALL CLQT01( M, N, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.CGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.LE.N ) THEN -* -* Test CUNGLQ, using factorization -* returned by CLQT01 -* - CALL CLQT02( M, N, K, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - ELSE - RESULT( 1 ) = ZERO - RESULT( 2 ) = ZERO - END IF - IF( M.GE.K ) THEN -* -* Test CUNMLQ, using factorization returned -* by CLQT01 -* - CALL CLQT03( M, N, K, AF, AC, AL, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call CGELQS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.M .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL CLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'CGELQS' - CALL CHAMELEON_CGELQS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from CGELQS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CGELQS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL CGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - ELSE - RESULT( 7 ) = ZERO - END IF - ELSE - RESULT( 3 ) = ZERO - RESULT( 4 ) = ZERO - RESULT( 5 ) = ZERO - RESULT( 6 ) = ZERO - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NT - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', - $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of CCHKLQ -* - END diff --git a/testing/lin/cchkpo.f b/testing/lin/cchkpo.f deleted file mode 100644 index 0946ade1986359a5af4ac1ee54f0869f0e2f0e22..0000000000000000000000000000000000000000 --- a/testing/lin/cchkpo.f +++ /dev/null @@ -1,477 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, - $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, - $ XACT, WORK, RWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) - REAL RWORK( * ) - COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), - $ WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CCHKPO tests CPOTRF, -TRI, -TRS, -RFS, and -CON -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AINV (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NSMAX) -* -* WORK (workspace) COMPLEX array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) REAL array, dimension -* (NMAX+2*NSMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX CZERO - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* .. -* .. Local Scalars .. - LOGICAL ZEROT - CHARACTER DIST, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO, - $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS, - $ NFAIL, NIMAT, NRHS, NRUN, CHAMELEON_UPLO - REAL ANORM, CNDNUM, RCOND, RCONDC -* .. -* .. Local Arrays .. - CHARACTER UPLOS( 2 ) - INTEGER CHAMELEON_UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL CLANHE, SGET06 - EXTERNAL CLANHE, SGET06 -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRPO, CGET04, CLACPY, - $ CLAIPD, CLARHS, CLATB4, CLATMS, CPOCON, CPORFS, - $ CPOT01, CPOT02, CPOT03, CPOT05, CPOTRF, CPOTRI, - $ CPOTRS, XLAENV -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL CERRPO( PATH, NOUT ) - INFOT = 0 -* -* Do for each value of N in NVAL -* - DO 120 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - IZERO = 0 - DO 110 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 110 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 110 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 100 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'CLATMS' - CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = CZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = CZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = CZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = CZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Set the imaginary part of the diagonals. -* - CALL CLAIPD( N, A, LDA+1, 0 ) -* -* Do for each value of NB in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (N / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Compute the L*L' or U'*U factorization of the matrix. -* - CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - SRNAMT = 'CPOTRF' - CALL CHAMELEON_CPOTRF( CHAMELEON_UPLO, N, AFAC, LDA, INFO ) -* -* Check error code from CPOTRF. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'CPOTRF', INFO, IZERO, UPLO, N, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - GO TO 90 - END IF -* -* Skip the tests if INFO is not 0. -* - IF( INFO.NE.0 ) - $ GO TO 90 -* -*+ TEST 1 -* Reconstruct matrix from factors and compute residual. -* - CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - CALL CPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK, - $ RESULT( 1 ) ) -* -*+ TEST 2 -* Form the inverse and compute the residual. -* - CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - SRNAMT = 'CPOTRI' - CALL CHAMELEON_CPOTRI( CHAMELEON_UPLO, N, AINV, LDA, - $ INFO ) -* -* Check error code from CPOTRI. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CPOTRI', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - CALL CPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, - $ RWORK, RCONDC, RESULT( 2 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 60 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + 2 -* -* Skip the rest of the tests unless this is the first -* blocksize. -* - IF( INB.NE.1 ) - $ GO TO 90 -* - DO 80 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) -* -*+ TEST 3 -* Solve and compute residual for A * X = B . -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'CPOTRS' - CALL CHAMELEON_CPOTRS( CHAMELEON_UPLO, N, NRHS, AFAC, - $ LDA, X, LDA, INFO ) -* -* Check error code from CPOTRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CPOTRS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) - CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -*+ TESTS 5, 6, and 7 -* Use iterative refinement to improve the solution. -* - SRNAMT = 'CPORFS' - CALL CPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B, - $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ), - $ WORK, RWORK( 2*NRHS+1 ), INFO ) -* -* Check error code from CPORFS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CPORFS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 5 ) ) - CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, - $ XACT, LDA, RWORK, RWORK( NRHS+1 ), - $ RESULT( 6 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 70 K = 3, 7 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 70 CONTINUE - NRUN = NRUN + 5 - 80 CONTINUE -* -*+ TEST 8 -* Get an estimate of RCOND = 1/CNDNUM. -* - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) - SRNAMT = 'CPOCON' - CALL CPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK, - $ RWORK, INFO ) -* -* Check error code from CPOCON. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CPOCON', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - RESULT( 8 ) = SGET06( RCOND, RCONDC ) -* -* Print the test ratio if it is .GE. THRESH. -* - IF( RESULT( 8 ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8, - $ RESULT( 8 ) - NFAIL = NFAIL + 1 - END IF - NRUN = NRUN + 1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', - $ I2, ', test ', I2, ', ratio =', G12.5 ) - 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of CCHKPO -* - END diff --git a/testing/lin/cchkqr.f b/testing/lin/cchkqr.f deleted file mode 100644 index 643f6a5e923fc0a3becf41b361f1036bde0879bd..0000000000000000000000000000000000000000 --- a/testing/lin/cchkqr.f +++ /dev/null @@ -1,409 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - REAL RWORK( * ) - COMPLEX A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), - $ B( * ), TAU( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CCHKQR tests CGEQRF, CUNGQR and CUNMQR. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AF (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AQ (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AR (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* TAU (workspace) COMPLEX array, dimension (NMAX) -* -* WORK (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* RWORK (workspace) REAL array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - REAL ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - REAL RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Fuinctions .. - LOGICAL CGENND - EXTERNAL CGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGET02, - $ CLACPY, CLARHS, CLATB4, CLATMS, CQRT01, CQRT02, - $ CQRT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'QR' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL CERRQR( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( M.LT.N ) - $ GO TO 60 - MINMN = MIN( M, N ) -* - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'CLATMS' - CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of CQRT01; other values are -* used in the calls of CQRT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGEQRF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test CGEQRF -* - CALL CQRT01( M, N, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.CGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.GE.N ) THEN -* -* Test CUNGQR, using factorization -* returned by CQRT01 -* - CALL CQRT02( M, N, K, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - END IF - IF( M.GE.K ) THEN -* -* Test CUNMQR, using factorization returned -* by CQRT01 -* - CALL CQRT03( M, N, K, AF, AC, AR, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call CGEQRS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.N .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL CLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'CGEQRS' - CALL CHAMELEON_CGEQRS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from CGEQRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CGEQRS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL CGET02( 'No transpose', M, N, NRHS, - $ A, LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - END IF - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NTESTS - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', - $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of CCHKQR -* - END diff --git a/testing/lin/cdrvge.f b/testing/lin/cdrvge.f deleted file mode 100644 index 9bd369e4b752ca8cd2644f95199c4bcd82009b08..0000000000000000000000000000000000000000 --- a/testing/lin/cdrvge.f +++ /dev/null @@ -1,472 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - REAL RWORK( * ), S( * ) - COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CDRVGE tests the driver routines CGESV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* ASAV (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* BSAV (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* S (workspace) REAL array, dimension (2*NMAX) -* -* WORK (workspace) COMPLEX array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) REAL array, dimension (2*NRHS+NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT - CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER CHAMELEON_TRANS, IB - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, - $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, - $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT - REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, - $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, - $ ROLDI, ROLDO, ROWCND, RPVGRW -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - REAL RDUM( 1 ), RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, CLANTR, SGET06, SLAMCH - EXTERNAL LSAME, CLANGE, CLANTR, SGET06, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGEEQU, CGESV, - $ CGESVX, CGET02, CGET04, CGETRF, - $ CGETRI, CLACPY, CLAQGE, CLARHS, CLASET, CLATB4, - $ CLATMS, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, CMPLX, MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* DATA TRANSS / 'N', 'T', 'C' / - DATA TRANSS / 'N' / - DATA CHAMELEON_TRANSS / CHAMELEONNOTRANS / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'R', 'C', 'B' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL CERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - IB = 32 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* Do for each value of N in NVAL -* - DO 90 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* -* ALLOCATE L and IPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_CGETRF_INCPIV( -c$$$ $ N, N, HL, HPIV, INFO ) -* -* - DO 80 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 80 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 80 -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) - RCONDC = ONE / CNDNUM -* - SRNAMT = 'CLATMS' - CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, - $ ANORM, KL, KU, 'No packing', A, LDA, WORK, - $ INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, -1, -1, - $ -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 80 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, N - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL CLASET( 'Full', N, N-IZERO+1, CMPLX( ZERO ), - $ CMPLX( ZERO ), A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL CLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) -* - DO 70 IEQUED = 1, 4 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 60 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 60 - RCONDO = ZERO - RCONDI = ZERO -* - ELSE IF( .NOT.NOFACT ) THEN -* -* Compute the condition number for comparison with -* the value returned by CGESVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL CLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL CGEEQU( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( LSAME( EQUED, 'R' ) ) THEN - ROWCND = ZERO - COLCND = ONE - ELSE IF( LSAME( EQUED, 'C' ) ) THEN - ROWCND = ONE - COLCND = ZERO - ELSE IF( LSAME( EQUED, 'B' ) ) THEN - ROWCND = ZERO - COLCND = ZERO - END IF -* -* Equilibrate the matrix. -* - CALL CLAQGE( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the non-equilibrated -* system for use in CGET04. -* - IF( EQUIL ) THEN - ROLDO = RCONDO - ROLDI = RCONDI - END IF -* -* Compute the 1-norm and infinity-norm of A. -* - ANORMO = CLANGE( '1', N, N, AFAC, LDA, RWORK ) - ANORMI = CLANGE( 'I', N, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* -c$$$ CALL CHAMELEON_CGETRF_INCPIV( N, N, AFAC, LDA, -c$$$ $ HL, HPIV, INFO ) - CALL CHAMELEON_CGETRF( N, N, AFAC, LDA, - $ IWORK, INFO ) - END IF -* - DO 50 ITRAN = 1, NTRAN -* -* Do for each value of TRANS. -* - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -* Restore the matrix A. -* - CALL CLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL CLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT .AND. ITRAN.EQ.1 ) THEN -* -* --- Test CGESV --- -* -* Compute the LU factorization of the matrix and -* solve the system. -* - CALL CLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) - CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'CGESV ' -c$$$ CALL CHAMELEON_CGESV_INCPIV( N, NRHS, AFAC, LDA, -c$$$ $ HL, HPIV, X, LDA, INFO ) - CALL CHAMELEON_CGESV( N, NRHS, AFAC, LDA, - $ IWORK, X, LDA, INFO ) -* -* Check error code from CGESV . -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'CGESV ', INFO, IZERO, - $ ' ', N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) -* - IF( IZERO.EQ.0 ) THEN -* -* Compute residual of the computed solution. -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL CGET02( 'No transpose', N, N, NRHS, A, - $ LDA, X, LDA, WORK, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 2 ) ) - NT = 2 - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'CGESV ', N, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT - END IF -* - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =', - $ G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', type ', I2, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', - $ G12.5 ) - RETURN -* -* End of CDRVGE -* - END diff --git a/testing/lin/cdrvls.f b/testing/lin/cdrvls.f deleted file mode 100644 index ac7703bbdc3b13809ab45d6d16b864fbcaa7445a..0000000000000000000000000000000000000000 --- a/testing/lin/cdrvls.f +++ /dev/null @@ -1,405 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ IBVAL, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, - $ B, COPYB, C, S, COPYS, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ NVAL( * ), NXVAL( * ), IBVAL( * ) - REAL COPYS( * ), RWORK( * ), S( * ) - COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ WORK( * ) -* .. -* -* Purpose -* ======= -* -* CDRVLS tests the least squares driver routines CGELS, CGELSX, CGELSS, -* CGELSY and CGELSD. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* The matrix of type j is generated as follows: -* j=1: A = U*D*V where U and V are random unitary matrices -* and D has random entries (> 0.1) taken from a uniform -* distribution (0,1). A is full rank. -* j=2: The same of 1, but A is scaled up. -* j=3: The same of 1, but A is scaled down. -* j=4: A = U*D*V where U and V are random unitary matrices -* and D has 3*min(M,N)/4 random entries (> 0.1) taken -* from a uniform distribution (0,1) and the remaining -* entries set to 0. A is rank-deficient. -* j=5: The same of 4, but A is scaled up. -* j=6: The same of 5, but A is scaled down. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NNB) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* A (workspace) COMPLEX array, dimension (MMAX*NMAX) -* where MMAX is the maximum value of M in MVAL and NMAX is the -* maximum value of N in NVAL. -* -* COPYA (workspace) COMPLEX array, dimension (MMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (MMAX*NSMAX) -* where MMAX is the maximum value of M in MVAL and NSMAX is the -* maximum value of NRHS in NSVAL. -* -* COPYB (workspace) COMPLEX array, dimension (MMAX*NSMAX) -* -* C (workspace) COMPLEX array, dimension (MMAX*NSMAX) -* -* S (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* -* WORK (workspace) COMPLEX array, dimension -* (MMAX*NMAX + 4*NMAX + MMAX). -* -* RWORK (workspace) REAL array, dimension (5*NMAX-1) -* -* IWORK (workspace) INTEGER array, dimension (15*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 18 ) - INTEGER SMLSIZ - PARAMETER ( SMLSIZ = 25 ) - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - COMPLEX CONE, CZERO - PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ), - $ CZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - CHARACTER TRANS - CHARACTER*3 PATH - INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NRHS, NROWS, NRUN, RANK, IB, - $ CHAMELEON_TRANS - INTEGER HT( 2 ) - REAL EPS, NORMA, NORMB, RCOND -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL CQRT14, CQRT17, SASUM, SLAMCH - EXTERNAL CQRT14, CQRT17, SASUM, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASVM, CERRLS, CGELS, CGELSD, - $ CGELSS, CGELSX, CGELSY, CGEMM, CLACPY, CLARNV, - $ CQRT13, CQRT15, CQRT16, CSSCAL, SAXPY, - $ XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, REAL, SQRT -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, IOUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, IOUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'LS' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE - EPS = SLAMCH( 'Epsilon' ) -* -* Threshold for rank estimation -* - RCOND = SQRT( EPS ) - ( SQRT( EPS )-EPS ) / 2 -* -* Test the error exits -* - CALL XLAENV( 9, SMLSIZ ) - IF( TSTERR ) - $ CALL CERRLS( PATH, NOUT ) -* -* Print the header if NM = 0 or NN = 0 and THRESH = 0. -* - IF( ( NM.EQ.0 .OR. NN.EQ.0 ) .AND. THRESH.EQ.ZERO ) - $ CALL ALAHD( NOUT, PATH ) - INFOT = 0 -* - DO 140 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* - DO 130 IN = 1, NN - N = NVAL( IN ) - MNMIN = MIN( M, N ) - LDB = MAX( 1, M, N ) -* - DO 120 INS = 1, NNS - NRHS = NSVAL( INS ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 2*N+M ) -* - DO 110 IRANK = 1, 2 - DO 100 ISCALE = 1, 3 - ITYPE = ( IRANK-1 )*3 + ISCALE - IF( .NOT.DOTYPE( ITYPE ) ) - $ GO TO 100 -* - IF( IRANK.EQ.1 ) THEN -* -* Test CGELS -* -* Generate a matrix of scaling type ISCALE -* - CALL CQRT13( ISCALE, M, N, COPYA, LDA, NORMA, - $ ISEED ) - DO 40 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - CALL XLAENV( 3, NXVAL( INB ) ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 40 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, - $ INFO ) -* -* Allocate T -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGELS( M, N , HT, - $ INFO ) -* -* DO 30 ITRAN = 1, 2 - DO 30 ITRAN = 1, 1 - IF( ITRAN.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - NROWS = M - NCOLS = N - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - NROWS = N - NCOLS = M - END IF - LDWORK = MAX( 1, NCOLS ) -* -* Set up a consistent rhs -* - IF( NCOLS.GT.0 ) THEN - CALL CLARNV( 2, ISEED, NCOLS*NRHS, - $ WORK ) - CALL CSSCAL( NCOLS*NRHS, - $ ONE / REAL( NCOLS ), WORK, - $ 1 ) - END IF - CALL CGEMM( TRANS, 'No transpose', NROWS, - $ NRHS, NCOLS, CONE, COPYA, LDA, - $ WORK, LDWORK, CZERO, B, LDB ) - CALL CLACPY( 'Full', NROWS, NRHS, B, LDB, - $ COPYB, LDB ) -* -* Solve LS or overdetermined system -* - IF( M.GT.0 .AND. N.GT.0 ) THEN - CALL CLACPY( 'Full', M, N, COPYA, LDA, - $ A, LDA ) - CALL CLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, B, LDB ) - END IF - SRNAMT = 'CGELS ' - CALL CHAMELEON_CGELS( CHAMELEON_TRANS, - $ M, N, NRHS, - $ A, LDA, HT, B, LDB, - $ INFO ) -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'CGELS ', INFO, 0, - $ TRANS, M, N, NRHS, -1, NB, - $ ITYPE, NFAIL, NERRS, - $ NOUT ) -* -* Check correctness of results -* - LDWORK = MAX( 1, NROWS ) - IF( NROWS.GT.0 .AND. NRHS.GT.0 ) - $ CALL CLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, C, LDB ) - CALL CQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, RWORK, - $ RESULT( 1 ) ) -* - IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. - $ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN -* -* Solving LS system -* - RESULT( 2 ) = CQRT17( TRANS, 1, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ COPYB, LDB, C, WORK, - $ LWORK ) - ELSE -* -* Solving overdetermined system -* - RESULT( 2 ) = CQRT14( TRANS, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ WORK, LWORK ) - END IF -* -* Print information about the tests that -* did not pass the threshold. -* - DO 20 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )TRANS, M, - $ N, NRHS, NB, ITYPE, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + 2 - 30 CONTINUE -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 40 CONTINUE - END IF -* - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) - 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, - $ ', type', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of CDRVLS -* - END diff --git a/testing/lin/cdrvpo.f b/testing/lin/cdrvpo.f deleted file mode 100644 index 034c99643cf69fb59f351e17fc5c86f8b06d4347..0000000000000000000000000000000000000000 --- a/testing/lin/cdrvpo.f +++ /dev/null @@ -1,567 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER NVAL( * ) - REAL RWORK( * ), S( * ) - COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* CDRVPO tests the driver routines CPOSV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* ASAV (workspace) COMPLEX array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* BSAV (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX array, dimension (NMAX*NRHS) -* -* S (workspace) REAL array, dimension (NMAX) -* -* WORK (workspace) COMPLEX array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) REAL array, dimension (NMAX+2*NRHS) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 6 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, ZEROT - CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, - $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, - $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, - $ CHAMELEON_UPLO - REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, - $ ROLDC, SCOND -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_UPLOS( 2 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANHE, SGET06 - EXTERNAL LSAME, CLANHE, SGET06 -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CLACPY, - $ CLAIPD, CLAQHE, CLARHS, CLASET, CLATB4, CLATMS, - $ CPOEQU, CPOSV, CPOSVX, CPOT01, CPOT02, CPOT05, - $ CPOTRF, CPOTRI, XLAENV -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'Y' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Complex precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL CERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Do for each value of N in NVAL -* - DO 130 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - DO 120 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 120 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 120 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 110 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with CLATB4 and generate a test matrix -* with CLATMS. -* - CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'CLATMS' - CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from CLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 110 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Set the imaginary part of the diagonals. -* - CALL CLAIPD( N, A, LDA+1, 0 ) -* -* Save a copy of the matrix A in ASAV. -* - CALL CLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) -* - DO 100 IEQUED = 1, 2 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 90 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 90 - RCONDC = ZERO -* - ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN -* -* Compute the condition number for comparison with -* the value returned by CPOSVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL CLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL CPOEQU( N, AFAC, LDA, S, SCOND, AMAX, - $ INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( IEQUED.GT.1 ) - $ SCOND = ZERO -* -* Equilibrate the matrix. -* - CALL CLAQHE( UPLO, N, AFAC, LDA, S, SCOND, - $ AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the -* non-equilibrated system for use in CGET04. -* - IF( EQUIL ) - $ ROLDC = RCONDC -* -* Compute the 1-norm of A. -* - ANORM = CLANHE( '1', UPLO, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* - CALL CHAMELEON_CPOTRF( CHAMELEON_UPLO, N, - $ AFAC, LDA, INFO ) -* -* Form the inverse of A. -* - CALL CLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) - CALL CHAMELEON_CPOTRI( CHAMELEON_UPLO, N, A, LDA, - $ INFO ) -* -* Compute the 1-norm condition number of A. -* - AINVNM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCONDC = ONE - ELSE - RCONDC = ( ONE / ANORM ) / AINVNM - END IF - END IF -* -* Restore the matrix A. -* - CALL CLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'CLARHS' - CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL CLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT ) THEN -* -* --- Test CPOSV --- -* -* Compute the L*L' or U'*U factorization of the -* matrix and solve the system. -* - CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'CPOSV ' - CALL CHAMELEON_CPOSV( CHAMELEON_UPLO, N, NRHS, - $ AFAC, LDA, X, LDA, INFO ) -* -* Check error code from CPOSV . -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'CPOSV ', INFO, IZERO, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - GO TO 70 - ELSE IF( INFO.NE.0 ) THEN - GO TO 70 - END IF -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL CPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Compute residual of the computed solution. -* - CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 -* -* Print information about the tests that did not -* pass the threshold. -* - DO 60 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'CPOSV ', UPLO, - $ N, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + NT - 70 CONTINUE - END IF -* -* --- Test CPOSVX --- -* - IF( .NOT.PREFAC ) - $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ), - $ CMPLX( ZERO ), AFAC, LDA ) - CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ), - $ CMPLX( ZERO ), X, LDA ) - IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN -* -* Equilibrate the matrix if FACT='F' and -* EQUED='Y'. -* - CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, - $ EQUED ) - END IF -* -* Solve the system and compute the condition number -* and error bounds using CPOSVX. -* - SRNAMT = 'CPOSVX' - CALL CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, - $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, - $ RWORK, RWORK( NRHS+1 ), WORK, - $ RWORK( 2*NRHS+1 ), INFO ) -* -* Check the error code from CPOSVX. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'CPOSVX', INFO, IZERO, - $ FACT // UPLO, N, N, -1, -1, NRHS, - $ IMAT, NFAIL, NERRS, NOUT ) - GO TO 90 - END IF -* - IF( INFO.EQ.0 ) THEN - IF( .NOT.PREFAC ) THEN -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL CPOT01( UPLO, N, A, LDA, AFAC, LDA, - $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) - K1 = 1 - ELSE - K1 = 2 - END IF -* -* Compute residual of the computed solution. -* - CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, - $ LDA ) - CALL CPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, - $ WORK, LDA, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, - $ 'N' ) ) ) THEN - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 3 ) ) - ELSE - CALL CGET04( N, NRHS, X, LDA, XACT, LDA, - $ ROLDC, RESULT( 3 ) ) - END IF -* -* Check the error bounds from iterative -* refinement. -* - CALL CPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, - $ X, LDA, XACT, LDA, RWORK, - $ RWORK( NRHS+1 ), RESULT( 4 ) ) - ELSE - K1 = 6 - END IF -* -* Compare RCOND from CPOSVX with the computed value -* in RCONDC. -* - RESULT( 6 ) = SGET06( RCOND, RCONDC ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 80 K = K1, 6 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - IF( PREFAC ) THEN - WRITE( NOUT, FMT = 9997 )'CPOSVX', FACT, - $ UPLO, N, EQUED, IMAT, K, RESULT( K ) - ELSE - WRITE( NOUT, FMT = 9998 )'CPOSVX', FACT, - $ UPLO, N, IMAT, K, RESULT( K ) - END IF - NFAIL = NFAIL + 1 - END IF - 80 CONTINUE - NRUN = NRUN + 7 - K1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, - $ ', test(', I1, ')=', G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', type ', I1, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', - $ G12.5 ) - RETURN -* -* End of CDRVPO -* - END diff --git a/testing/lin/cerrge.f b/testing/lin/cerrge.f deleted file mode 100644 index c61c1c408f49f6b8949b462dca22705cb48c772a..0000000000000000000000000000000000000000 --- a/testing/lin/cerrge.f +++ /dev/null @@ -1,237 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRGE( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRGE tests the error exits for the COMPLEX routines -* for general matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL ANRM, CCOND, RCOND -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - INTEGER HL( 2 ), HPIV( 2 ) - REAL R( NMAX ), R1( NMAX ), R2( NMAX ) - COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CGBCON, CGBEQU, CGBRFS, CGBTF2, CGBTRF, - $ CGBTRS, CGECON, CGEEQU, CGERFS, CGETF2, CGETRF, - $ CGETRI, CGETRS, CHKXER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - IP( J ) = J - 20 CONTINUE - OK = .TRUE. -* -* Test error exits of the routines that use the LU decomposition -* of a general matrix. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE L and IPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* CGETRF -* - SRNAMT = 'CGETRF' - INFOT = 1 - CALL CHAMELEON_CGETRF_INCPIV( -1, 0, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGETRF_INCPIV( 0, -1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGETRF_INCPIV( 2, 1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) -* -* CGETRS -* - SRNAMT = 'CGETRS' - INFOT = 103 - CALL CHAMELEON_CGETRS_INCPIV( '/', -1, 0, A, 1, HL, HPIV, - $ B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGETRS_INCPIV( CHAMELEONNOTRANS, -1, 0, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CGETRS_INCPIV( CHAMELEONNOTRANS, 0, -1, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 1, HL, - $ HPIV, B, 2, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_CGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 2, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE L and IPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* LAPACK Interface -* CGETRF -* - SRNAMT = 'CGETRF' - INFOT = 1 - CALL CHAMELEON_CGETRF( -1, 0, A, 1, IP, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGETRF( 0, -1, A, 1, IP, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGETRF( 2, 1, A, 1, IP, INFO ) - CALL CHKXER( 'CGETRF', INFOT, NOUT, INFO, OK ) -* -* CGETRS -* - SRNAMT = 'CGETRS' - INFOT = 1 - CALL CHAMELEON_CGETRS( '/', 0, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGETRS( CHAMELEONNOTRANS, -1, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CGETRS( CHAMELEONNOTRANS, 0, -1, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CGETRS( CHAMELEONNOTRANS, 2, 1, A, 1, IP, - $ B, 2, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_CGETRS( CHAMELEONNOTRANS, 2, 1, A, 2, IP, - $ B, 1, INFO ) - CALL CHKXER( 'CGETRS', INFOT, NOUT, INFO, OK ) -* - ENDIF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRGE -* - END diff --git a/testing/lin/cerrlq.f b/testing/lin/cerrlq.f deleted file mode 100644 index dc948d082129b2c443b1567e8036ef30ffc50070..0000000000000000000000000000000000000000 --- a/testing/lin/cerrlq.f +++ /dev/null @@ -1,248 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRLQ( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRLQ tests the error exits for the COMPLEX routines -* that use the LQ decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CGELQ2, CGELQF, CHKXER, CUNGL2, - $ CUNGLQ, CUNML2, CUNMLQ -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - 10 CONTINUE - B( J ) = 0. - W( J ) = 0. - X( J ) = 0. - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGELQF( 2, 2, HT, INFO ) -* -* Error exits for LQ factorization -* -* CGELQF -* - SRNAMT = 'CGELQF' - INFOT = 1 - CALL CHAMELEON_CGELQF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'CGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGELQF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'CGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGELQF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'CGELQF', INFOT, NOUT, INFO, OK ) -* -* CGELQS -* - SRNAMT = 'CGELQS' - INFOT = 1 - CALL CHAMELEON_CGELQS( -1, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGELQS( 0, -1, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGELQS( 2, 1, 0, A, 2, HT, B, 1, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CGELQS( 0, 0, -1, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CGELQS( 2, 2, 0, A, 1, HT, B, 2, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_CGELQS( 1, 2, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'CGELQS', INFOT, NOUT, INFO, OK ) -* -* CUNGLQ -* - SRNAMT = 'CUNGLQ' - INFOT = 1 - CALL CHAMELEON_CUNGLQ( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNGLQ( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNGLQ( 2, 1, 0, A, 2, HT, W, 2, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNGLQ( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNGLQ( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CUNGLQ( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_CUNGLQ( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGLQ', INFOT, NOUT, INFO, OK ) -* -* CUNMLQ -* - SRNAMT = 'CUNMLQ' - INFOT = 1 - CALL CHAMELEON_CUNMLQ( '/', CHAMELEONCONJTRANS, 0, 0, 0, A, 1, HT, AF, - $ 1, INFO ) - CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, -1, 0, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, -1, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 0, -1, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 1, 1, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_CUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 1, 0, 1, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 0, 2, A, 1, HT, AF, 2, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_CUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 0, 2, 2, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 2, HT, AF, 1, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_CUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_CUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, HT, AF, 2, INFO ) -* CALL CHKXER( 'CUNMLQ', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRLQ -* - END diff --git a/testing/lin/cerrls.f b/testing/lin/cerrls.f deleted file mode 100644 index 89d85fff4c2a538691cc0e866ce29c09fd114df6..0000000000000000000000000000000000000000 --- a/testing/lin/cerrls.f +++ /dev/null @@ -1,166 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRLS( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRLS tests the error exits for the COMPLEX least squares -* driver routines (CGELS, CGELSS, CGELSX, CGELSY, CGELSD). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER INFO, IRNK - REAL RCOND - INTEGER HT( 2 ) -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - REAL RW( NMAX ), S( NMAX ) - COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CGELS, CGELSD, CGELSS, CGELSX, CGELSY, - $ CHKXER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - C2 = PATH( 2: 3 ) - A( 1, 1 ) = ( 1.0E+0, 0.0E+0 ) - A( 1, 2 ) = ( 2.0E+0, 0.0E+0 ) - A( 2, 2 ) = ( 3.0E+0, 0.0E+0 ) - A( 2, 1 ) = ( 4.0E+0, 0.0E+0 ) - OK = .TRUE. - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Test error exits for the least squares driver routines. -* - IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* CGELS -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGELS( 2, 2, HT, INFO ) -* - SRNAMT = 'CGELS ' - INFOT = 103 - CALL CHAMELEON_CGELS( '/', 0, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGELS( CHAMELEONNOTRANS, -1, 0, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CGELS( CHAMELEONNOTRANS, 0, -1, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGELS( CHAMELEONNOTRANS, 0, 0, -1, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL CHAMELEON_CGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 1, HT, - $ B, 2, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_CGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 2, HT, - $ B, 1, INFO ) - CALL CHKXER( 'CGELS ', INFOT, NOUT, INFO, OK ) -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRLS -* - END diff --git a/testing/lin/cerrpo.f b/testing/lin/cerrpo.f deleted file mode 100644 index 6833586773514658105b4e7362533abbf9b9907a..0000000000000000000000000000000000000000 --- a/testing/lin/cerrpo.f +++ /dev/null @@ -1,181 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRPO( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRPO tests the error exits for the COMPLEX routines -* for Hermitian positive definite matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL ANRM, RCOND -* .. -* .. Local Arrays .. - REAL R( NMAX ), R1( NMAX ), R2( NMAX ) - COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, CPBCON, CPBEQU, CPBRFS, CPBTF2, - $ CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2, - $ CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS, - $ CPPTRF, CPPTRI, CPPTRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - 20 CONTINUE - ANRM = 1. - OK = .TRUE. -* -* Test error exits of the routines that use the Cholesky -* decomposition of a Hermitian positive definite matrix. -* - IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* CPOTRF -* - SRNAMT = 'CPOTRF' - INFOT = 1 - CALL CHAMELEON_CPOTRF( '/', 0, A, 1, INFO ) - CALL CHKXER( 'CPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CPOTRF( CHAMELEONUPPER, -1, A, 1, INFO ) - CALL CHKXER( 'CPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CPOTRF( CHAMELEONUPPER, 2, A, 1, INFO ) - CALL CHKXER( 'CPOTRF', INFOT, NOUT, INFO, OK ) -* -* CPOTRS -* - SRNAMT = 'CPOTRS' - INFOT = 1 - CALL CHAMELEON_CPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CPOTRS( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CPOTRS( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CPOTRS( CHAMELEONUPPER, 2, 1, A, 1, B, 2, INFO ) - CALL CHKXER( 'CPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_CPOTRS( CHAMELEONUPPER, 2, 1, A, 2, B, 1, INFO ) - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRPO -* - END diff --git a/testing/lin/cerrqr.f b/testing/lin/cerrqr.f deleted file mode 100644 index cfae5213fb561ac5dfc874a55875b7fcf6dce087..0000000000000000000000000000000000000000 --- a/testing/lin/cerrqr.f +++ /dev/null @@ -1,250 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRQR( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRQR tests the error exits for the COMPLEX routines -* that use the QR decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CGEQR2, CGEQRF, CHKXER, CUNG2R, - $ CUNGQR, CUNM2R, CUNMQR -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - 10 CONTINUE - B( J ) = 0. - W( J ) = 0. - X( J ) = 0. - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGEQRF( 2, 2, HT, INFO ) -* -* Error exits for QR factorization -* -* CGEQRF -* - SRNAMT = 'CGEQRF' - INFOT = 1 - CALL CHAMELEON_CGEQRF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'CGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGEQRF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'CGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGEQRF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'CGEQRF', INFOT, NOUT, INFO, OK ) -* -* CGEQRS -* - SRNAMT = 'CGEQRS' - INFOT = 1 - CALL CHAMELEON_CGEQRS( -1, 0, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGEQRS( 0, -1, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGEQRS( 1, 2, 0, A, 2, X, B, 2, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CGEQRS( 0, 0, -1, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CGEQRS( 2, 1, 0, A, 1, X, B, 2, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_CGEQRS( 2, 1, 0, A, 2, X, B, 1, INFO ) - CALL CHKXER( 'CGEQRS', INFOT, NOUT, INFO, OK ) -* -* CUNGQR -* - SRNAMT = 'CUNGQR' - INFOT = 1 - CALL CHAMELEON_CUNGQR( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNGQR( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNGQR( 1, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNGQR( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNGQR( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CUNGQR( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_CUNGQR( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'CUNGQR', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_CUNMQR -* - SRNAMT = 'CUNMQR' - INFOT = 1 - CALL CHAMELEON_CUNMQR( '/', CHAMELEONCONJTRANS, 0, 0, 0, A, 1, HT, AF, - $ 1, INFO ) - CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, -1, 0, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, -1, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 0, -1, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 1, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 0, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_CUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'CUNMQR', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRQR -* - END diff --git a/testing/lin/cerrvx.f b/testing/lin/cerrvx.f deleted file mode 100644 index 386802713decf95356233797204279148d4400d0..0000000000000000000000000000000000000000 --- a/testing/lin/cerrvx.f +++ /dev/null @@ -1,273 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CERRVX( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* CERRVX tests the error exits for the COMPLEX driver routines -* for solving linear systems of equations. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER EQ - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL RCOND -* .. -* .. Local Arrays .. - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER IP( NMAX ) - REAL C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), - $ RF( NMAX ), RW( NMAX ) - COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ), IW( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL CGBSV, CGBSVX, CGESV, CGESVX, CGTSV, CGTSVX, - $ CHESV, CHESVX, CHKXER, CHPSV, CHPSVX, CPBSV, - $ CPBSVX, CPOSV, CPOSVX, CPPSV, CPPSVX, CPTSV, - $ CPTSVX, CSPSV, CSPSVX, CSYSV, CSYSVX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - C( J ) = 0. - R( J ) = 0. - IP( J ) = J - 20 CONTINUE - EQ = ' ' - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE HL and HPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_CGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* -* CGESV -* - SRNAMT = 'CGESV ' - INFOT = 1 - CALL CHAMELEON_CGESV_INCPIV( -1, 0, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGESV_INCPIV( 0, -1, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGESV_INCPIV( 2, 1, A, 1, HL, HPIV, B, 2, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_CGESV_INCPIV( 2, 1, A, 2, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE HL and HPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* -* CGESV -* - SRNAMT = 'CGESV ' - INFOT = 1 - CALL CHAMELEON_CGESV( -1, 0, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CGESV( 0, -1, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_CGESV( 2, 1, A, 1, IWORK, B, 2, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_CGESV( 2, 1, A, 2, IWORK, B, 1, INFO ) - CALL CHKXER( 'CGESV ', INFOT, NOUT, INFO, OK ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* CPOSV -* - SRNAMT = 'CPOSV ' - INFOT = 1 - CALL CHAMELEON_CPOSV( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_CPOSV( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_CPOSV( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'CPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_CPOSV( CHAMELEONUPPER, 2, 0, A, 1, B, 2, INFO ) - CALL CHKXER( 'CPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_CPOSV( CHAMELEONUPPER, 2, 0, A, 2, B, 1, INFO ) - CALL CHKXER( 'CPOSV ', INFOT, NOUT, INFO, OK ) -* -* CPOSVX -* - SRNAMT = 'CPOSVX' - INFOT = 1 - CALL CPOSVX( '/', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CPOSVX( 'N', '/', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CPOSVX( 'N', 'U', -1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CPOSVX( 'N', 'U', 0, -1, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL CPOSVX( 'N', 'U', 2, 0, A, 1, AF, 2, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CPOSVX( 'N', 'U', 2, 0, A, 2, AF, 1, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 9 - EQ = '/' - CALL CPOSVX( 'F', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 10 - EQ = 'Y' - CALL CPOSVX( 'F', 'U', 1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 12 - CALL CPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 1, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 14 - CALL CPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 2, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'CPOSVX', INFOT, NOUT, INFO, OK ) - END IF -* -* Print a summary line. -* - IF( OK ) THEN - WRITE( NOUT, FMT = 9999 )PATH - ELSE - WRITE( NOUT, FMT = 9998 )PATH - END IF -* - 9999 FORMAT( 1X, A3, ' drivers passed the tests of the error exits' ) - 9998 FORMAT( ' *** ', A3, ' drivers failed the tests of the error ', - $ 'exits ***' ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of CERRVX -* - END diff --git a/testing/lin/cgeequ.f b/testing/lin/cgeequ.f deleted file mode 100644 index 34718ea934c49f9be332cd6dbdfdc8dc156e47df..0000000000000000000000000000000000000000 --- a/testing/lin/cgeequ.f +++ /dev/null @@ -1,270 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, M, N - REAL AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - REAL C( * ), R( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CGEEQU computes row and column scalings intended to equilibrate an -* M-by-N matrix A and reduce its condition number. R returns the row -* scale factors and C the column scale factors, chosen to try to make -* the largest element in each row and column of the matrix B with -* elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1. -* -* R(i) and C(j) are restricted to be between SMLNUM = smallest safe -* number and BIGNUM = largest safe number. Use of these scaling -* factors is not guaranteed to reduce the condition number of A but -* works well in practice. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The M-by-N matrix whose equilibration factors are -* to be computed. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* R (output) REAL array, dimension (M) -* If INFO = 0 or INFO > M, R contains the row scale factors -* for A. -* -* C (output) REAL array, dimension (N) -* If INFO = 0, C contains the column scale factors for A. -* -* ROWCND (output) REAL -* If INFO = 0 or INFO > M, ROWCND contains the ratio of the -* smallest R(i) to the largest R(i). If ROWCND >= 0.1 and -* AMAX is neither too large nor too small, it is not worth -* scaling by R. -* -* COLCND (output) REAL -* If INFO = 0, COLCND contains the ratio of the smallest -* C(i) to the largest C(i). If COLCND >= 0.1, it is not -* worth scaling by C. -* -* AMAX (output) REAL -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= M: the i-th row of A is exactly zero -* > M: the (i-M)-th column of A is exactly zero -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL BIGNUM, RCMAX, RCMIN, SMLNUM - COMPLEX ZDUM -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, MIN, REAL -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CGEEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) THEN - ROWCND = ONE - COLCND = ONE - AMAX = ZERO - RETURN - END IF -* -* Get machine constants. -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* -* Compute row scale factors. -* - DO 10 I = 1, M - R( I ) = ZERO - 10 CONTINUE -* -* Find the maximum element in each row. -* - DO 30 J = 1, N - DO 20 I = 1, M - R( I ) = MAX( R( I ), CABS1( A( I, J ) ) ) - 20 CONTINUE - 30 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 40 I = 1, M - RCMAX = MAX( RCMAX, R( I ) ) - RCMIN = MIN( RCMIN, R( I ) ) - 40 CONTINUE - AMAX = RCMAX -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 50 I = 1, M - IF( R( I ).EQ.ZERO ) THEN - INFO = I - RETURN - END IF - 50 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 60 I = 1, M - R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) - 60 CONTINUE -* -* Compute ROWCND = min(R(I)) / max(R(I)) -* - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* -* Compute column scale factors -* - DO 70 J = 1, N - C( J ) = ZERO - 70 CONTINUE -* -* Find the maximum element in each column, -* assuming the row scaling computed above. -* - DO 90 J = 1, N - DO 80 I = 1, M - C( J ) = MAX( C( J ), CABS1( A( I, J ) )*R( I ) ) - 80 CONTINUE - 90 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 100 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 100 CONTINUE -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 110 J = 1, N - IF( C( J ).EQ.ZERO ) THEN - INFO = M + J - RETURN - END IF - 110 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 120 J = 1, N - C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) - 120 CONTINUE -* -* Compute COLCND = min(C(J)) / max(C(J)) -* - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* - RETURN -* -* End of CGEEQU -* - END diff --git a/testing/lin/cgennd.f b/testing/lin/cgennd.f deleted file mode 100644 index 9af6de6d2241f05a667a4562f2432a216e72e977..0000000000000000000000000000000000000000 --- a/testing/lin/cgennd.f +++ /dev/null @@ -1,97 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - LOGICAL FUNCTION CGENND (M, N, A, LDA) - IMPLICIT NONE -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* February 2008 -* -* .. Scalar Arguments .. - INTEGER M, N, LDA -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CGENND tests that its argument has a real, non-negative diagonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows in A. -* -* N (input) INTEGER -* The number of columns in A. -* -* A (input) COMPLEX array, dimension (LDA, N) -* The matrix. -* -* LDA (input) INTEGER -* Leading dimension of A. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL OUT - INTEGER I, K - COMPLEX AII -* .. -* .. Intrinsics .. - INTRINSIC MIN, REAL, AIMAG -* .. -* .. Executable Statements .. - K = MIN( M, N ) - DO I = 1, K - AII = A( I, I ) - IF( REAL( AII ).LT.ZERO.OR.AIMAG( AII ).NE.ZERO ) THEN - CGENND = .FALSE. - RETURN - END IF - END DO - CGENND = .TRUE. - RETURN - END diff --git a/testing/lin/cget02.f b/testing/lin/cget02.f deleted file mode 100644 index 44aaaefd157fbf7a42c96ba8c94b48ac59827d2d..0000000000000000000000000000000000000000 --- a/testing/lin/cget02.f +++ /dev/null @@ -1,185 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CGET02 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A^T*x = b, where A^T is the transpose of A -* = 'C': A^H*x = b, where A^H is the conjugate transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) COMPLEX array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX CONE - PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - REAL ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SCASUM, SLAMCH - EXTERNAL LSAME, CLANGE, SCASUM, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - N1 = N - N2 = M - ELSE - N1 = M - N2 = N - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = CLANGE( '1', N1, N2, A, LDA, RWORK ) - RHSNORM = CLANGE( '1', N1, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL CGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X, - $ LDX, CONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SCASUM( N1, B( 1, J ), 1 ) - XNORM = SCASUM( N2, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N1 *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of CGET02 -* - END diff --git a/testing/lin/cget04.f b/testing/lin/cget04.f deleted file mode 100644 index fbfca4b3367ba91e71807d8ef78b2d4957776500..0000000000000000000000000000000000000000 --- a/testing/lin/cget04.f +++ /dev/null @@ -1,161 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDX, LDXACT, N, NRHS - REAL RCOND, RESID -* .. -* .. Array Arguments .. - COMPLEX X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* CGET04 computes the difference between a computed solution and the -* true solution to a system of linear equations. -* -* RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), -* where RCOND is the reciprocal of the condition number and EPS is the -* machine epsilon. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of rows of the matrices X and XACT. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and XACT. NRHS >= 0. -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) COMPLEX array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* RCOND (input) REAL -* The reciprocal of the condition number of the coefficient -* matrix in the system of equations. -* -* RESID (output) REAL -* The maximum over the NRHS solution vectors of -* ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, IX, J - REAL DIFFNM, EPS, XNORM - COMPLEX ZDUM -* .. -* .. External Functions .. - INTEGER ICAMAX - REAL SLAMCH - EXTERNAL ICAMAX, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, REAL -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if RCOND is invalid. -* - EPS = SLAMCH( 'Epsilon' ) - IF( RCOND.LT.ZERO ) THEN - RESID = 1.0 / EPS - RETURN - END IF -* -* Compute the maximum of -* norm(X - XACT) / ( norm(XACT) * EPS ) -* over all the vectors X and XACT . -* - RESID = ZERO - DO 20 J = 1, NRHS - IX = ICAMAX( N, XACT( 1, J ), 1 ) - XNORM = CABS1( XACT( IX, J ) ) - DIFFNM = ZERO - DO 10 I = 1, N - DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE - IF( XNORM.LE.ZERO ) THEN - IF( DIFFNM.GT.ZERO ) - $ RESID = 1.0 / EPS - ELSE - RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) - END IF - 20 CONTINUE - IF( RESID*EPS.LT.1.0 ) - $ RESID = RESID / EPS -* - RETURN -* -* End of CGET04 -* - END diff --git a/testing/lin/chameleon_lintesting.py b/testing/lin/chameleon_lintesting.py deleted file mode 100755 index 66e351d93a3aa34bd8840c1420ca52e439e35822..0000000000000000000000000000000000000000 --- a/testing/lin/chameleon_lintesting.py +++ /dev/null @@ -1,37 +0,0 @@ -#! /usr/bin/env python -# -*- coding: utf-8 -*- - -import os -import sys -filename = "testing_results.txt" -f = open(filename, "w") # erase the file if it exists -f.close() - -# Add current directory to the path for subshells of this shell -# Allows the popen to find local files in both windows and unixes -os.environ["PATH"] = os.environ["PATH"]+":." - -print ' ' -print '---------------- LAPACK LIN Testing with CHAMELEON ----------------' -print ' ' -print '-- Detailed results are stored in', filename - -dtypes = ( -("s", "d", "c", "z"), -("Single", "Double", "Complex", "Double Complex"), -) -for dtype in range(4): - letter = dtypes[0][dtype] - name = dtypes[1][dtype] - print " " - print "------------------------- %s ------------------------" % name - print " " - sys.stdout.flush() # make sure progress of testing is shown - f = open(filename, "a") - test1 = os.popen("chameleon_xlintst%s < %stest.in" % (letter, letter)) - for line in test1.readlines(): - f.write(str(line)) - if "passed" in line : print line, - if "failed" in line : print "\n Failure =======>", line - if "recorded" in line : print "\n ===>", line - f.close() diff --git a/testing/lin/chkxer.f b/testing/lin/chkxer.f deleted file mode 100644 index 6bb44de8894cd49c9f7d7842769eeafc56d111fc..0000000000000000000000000000000000000000 --- a/testing/lin/chkxer.f +++ /dev/null @@ -1,67 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, INFO, OK ) -* -* Tests whether XERBLA has detected an error when it should. -* -* Auxiliary routine for test program for Level 2 Blas. -* -* -- Written on 10-August-1987. -* Richard Hanson, Sandia National Labs. -* Jeremy Du Croz, NAG Central Office. -* -* ===================================================================== -* -* .. Scalar Arguments .. - LOGICAL OK - CHARACTER*6 SRNAMT - INTEGER INFOT, INFO, NOUT -* .. -* .. Executable Statements .. - IF( INFOT.NE.ABS( INFO ) ) THEN - WRITE( NOUT, FMT = 9999 ) INFOT, SRNAMT - OK = .FALSE. - END IF - RETURN -* - 9999 FORMAT( ' *** Illegal value of parameter number ', I2, - $ ' not detected by ', A6, ' ***' ) -* -* End of CHKXER. -* - END diff --git a/testing/lin/clacn2.f b/testing/lin/clacn2.f deleted file mode 100644 index c60299527fe6c0dc647762479c76f87a481bfbd7..0000000000000000000000000000000000000000 --- a/testing/lin/clacn2.f +++ /dev/null @@ -1,258 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLACN2( N, V, X, EST, KASE, ISAVE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER KASE, N - REAL EST -* .. -* .. Array Arguments .. - INTEGER ISAVE( 3 ) - COMPLEX V( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* CLACN2 estimates the 1-norm of a square, complex matrix A. -* Reverse communication is used for evaluating matrix-vector products. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix. N >= 1. -* -* V (workspace) COMPLEX array, dimension (N) -* On the final return, V = A*W, where EST = norm(V)/norm(W) -* (W is not returned). -* -* X (input/output) COMPLEX array, dimension (N) -* On an intermediate return, X should be overwritten by -* A * X, if KASE=1, -* A' * X, if KASE=2, -* where A' is the conjugate transpose of A, and CLACN2 must be -* re-called with all the other parameters unchanged. -* -* EST (input/output) REAL -* On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be -* unchanged from the previous call to CLACN2. -* On exit, EST is an estimate (a lower bound) for norm(A). -* -* KASE (input/output) INTEGER -* On the initial call to CLACN2, KASE should be 0. -* On an intermediate return, KASE will be 1 or 2, indicating -* whether X should be overwritten by A * X or A' * X. -* On the final return from CLACN2, KASE will again be 0. -* -* ISAVE (input/output) INTEGER array, dimension (3) -* ISAVE is used to save variables between calls to SLACN2 -* -* Further Details -* ======= ======= -* -* Contributed by Nick Higham, University of Manchester. -* Originally named CONEST, dated March 16, 1988. -* -* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of -* a real or complex matrix, with applications to condition estimation", -* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. -* -* Last modified: April, 1999 -* -* This is a thread safe version of CLACON, which uses the array ISAVE -* in place of a SAVE statement, as follows: -* -* CLACON CLACN2 -* JUMP ISAVE(1) -* J ISAVE(2) -* ITER ISAVE(3) -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - REAL ONE, TWO - PARAMETER ( ONE = 1.0E0, TWO = 2.0E0 ) - COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ), - $ CONE = ( 1.0E0, 0.0E0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, JLAST - REAL ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP -* .. -* .. External Functions .. - INTEGER ICMAX1 - REAL SCSUM1, SLAMCH - EXTERNAL ICMAX1, SCSUM1, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CCOPY -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, CMPLX, REAL -* .. -* .. Executable Statements .. -* - SAFMIN = SLAMCH( 'Safe minimum' ) - IF( KASE.EQ.0 ) THEN - DO 10 I = 1, N - X( I ) = CMPLX( ONE / REAL( N ) ) - 10 CONTINUE - KASE = 1 - ISAVE( 1 ) = 1 - RETURN - END IF -* - GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 ) -* -* ................ ENTRY (ISAVE( 1 ) = 1) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. -* - 20 CONTINUE - IF( N.EQ.1 ) THEN - V( 1 ) = X( 1 ) - EST = ABS( V( 1 ) ) -* ... QUIT - GO TO 130 - END IF - EST = SCSUM1( N, X, 1 ) -* - DO 30 I = 1, N - ABSXI = ABS( X( I ) ) - IF( ABSXI.GT.SAFMIN ) THEN - X( I ) = CMPLX( REAL( X( I ) ) / ABSXI, - $ AIMAG( X( I ) ) / ABSXI ) - ELSE - X( I ) = CONE - END IF - 30 CONTINUE - KASE = 2 - ISAVE( 1 ) = 2 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 2) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. -* - 40 CONTINUE - ISAVE( 2 ) = ICMAX1( N, X, 1 ) - ISAVE( 3 ) = 2 -* -* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. -* - 50 CONTINUE - DO 60 I = 1, N - X( I ) = CZERO - 60 CONTINUE - X( ISAVE( 2 ) ) = CONE - KASE = 1 - ISAVE( 1 ) = 3 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 3) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 70 CONTINUE - CALL CCOPY( N, X, 1, V, 1 ) - ESTOLD = EST - EST = SCSUM1( N, V, 1 ) -* -* TEST FOR CYCLING. - IF( EST.LE.ESTOLD ) - $ GO TO 100 -* - DO 80 I = 1, N - ABSXI = ABS( X( I ) ) - IF( ABSXI.GT.SAFMIN ) THEN - X( I ) = CMPLX( REAL( X( I ) ) / ABSXI, - $ AIMAG( X( I ) ) / ABSXI ) - ELSE - X( I ) = CONE - END IF - 80 CONTINUE - KASE = 2 - ISAVE( 1 ) = 4 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 4) -* X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. -* - 90 CONTINUE - JLAST = ISAVE( 2 ) - ISAVE( 2 ) = ICMAX1( N, X, 1 ) - IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND. - $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN - ISAVE( 3 ) = ISAVE( 3 ) + 1 - GO TO 50 - END IF -* -* ITERATION COMPLETE. FINAL STAGE. -* - 100 CONTINUE - ALTSGN = ONE - DO 110 I = 1, N - X( I ) = CMPLX( ALTSGN*( ONE + REAL( I-1 ) / REAL( N-1 ) ) ) - ALTSGN = -ALTSGN - 110 CONTINUE - KASE = 1 - ISAVE( 1 ) = 5 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 5) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 120 CONTINUE - TEMP = TWO*( SCSUM1( N, X, 1 ) / REAL( 3*N ) ) - IF( TEMP.GT.EST ) THEN - CALL CCOPY( N, X, 1, V, 1 ) - EST = TEMP - END IF -* - 130 CONTINUE - KASE = 0 - RETURN -* -* End of CLACN2 -* - END diff --git a/testing/lin/clagge.f b/testing/lin/clagge.f deleted file mode 100644 index 0e4e31ebe31e0195782a217246f80b27b73d68aa..0000000000000000000000000000000000000000 --- a/testing/lin/clagge.f +++ /dev/null @@ -1,331 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, KL, KU, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL D( * ) - COMPLEX A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* CLAGGE generates a complex general m by n matrix A, by pre- and post- -* multiplying a real diagonal matrix D with random unitary matrices: -* A = U*D*V. The lower and upper bandwidths may then be reduced to -* kl and ku by additional unitary transformations. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= KL <= M-1. -* -* KU (input) INTEGER -* The number of nonzero superdiagonals within the band of A. -* 0 <= KU <= N-1. -* -* D (input) REAL array, dimension (min(M,N)) -* The diagonal elements of the diagonal matrix D. -* -* A (output) COMPLEX array, dimension (LDA,N) -* The generated m by n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) COMPLEX array, dimension (M+N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO, ONE - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ), - $ ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL WN - COMPLEX TAU, WA, WB -* .. -* .. External Subroutines .. - EXTERNAL CGEMV, CGERC, CLACGV, CLARNV, CSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, REAL -* .. -* .. External Functions .. - REAL SCNRM2 - EXTERNAL SCNRM2 -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN - INFO = -3 - ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -7 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'CLAGGE', -INFO ) - RETURN - END IF -* -* initialize A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = 1, M - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( M, N ) - A( I, I ) = D( I ) - 30 CONTINUE -* -* pre- and post-multiply A by random unitary matrices -* - DO 40 I = MIN( M, N ), 1, -1 - IF( I.LT.M ) THEN -* -* generate random reflection -* - CALL CLARNV( 3, ISEED, M-I+1, WORK ) - WN = SCNRM2( M-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL CSCAL( M-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* multiply A(i:m,i:n) by random reflection from the left -* - CALL CGEMV( 'Conjugate transpose', M-I+1, N-I+1, ONE, - $ A( I, I ), LDA, WORK, 1, ZERO, WORK( M+1 ), 1 ) - CALL CGERC( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1, - $ A( I, I ), LDA ) - END IF - IF( I.LT.N ) THEN -* -* generate random reflection -* - CALL CLARNV( 3, ISEED, N-I+1, WORK ) - WN = SCNRM2( N-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL CSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* multiply A(i:m,i:n) by random reflection from the right -* - CALL CGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ), - $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 ) - CALL CGERC( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, - $ A( I, I ), LDA ) - END IF - 40 CONTINUE -* -* Reduce number of subdiagonals to KL and number of superdiagonals -* to KU -* - DO 70 I = 1, MAX( M-1-KL, N-1-KU ) - IF( KL.LE.KU ) THEN -* -* annihilate subdiagonal elements first (necessary if KL = 0) -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = SCNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = ( WN / ABS( A( KL+I, I ) ) )*A( KL+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL CSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL CGEMV( 'Conjugate transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL CGERC( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, - $ 1, A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = SCNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = ( WN / ABS( A( I, KU+I ) ) )*A( I, KU+I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL CSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL CLACGV( N-KU-I+1, A( I, KU+I ), LDA ) - CALL CGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL CGERC( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF - ELSE -* -* annihilate superdiagonal elements first (necessary if -* KU = 0) -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = SCNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = ( WN / ABS( A( I, KU+I ) ) )*A( I, KU+I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL CSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL CLACGV( N-KU-I+1, A( I, KU+I ), LDA ) - CALL CGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL CGERC( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = SCNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = ( WN / ABS( A( KL+I, I ) ) )*A( KL+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL CSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL CGEMV( 'Conjugate transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL CGERC( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, - $ 1, A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF - END IF -* - DO 50 J = KL + I + 1, M - A( J, I ) = ZERO - 50 CONTINUE -* - DO 60 J = KU + I + 1, N - A( I, J ) = ZERO - 60 CONTINUE - 70 CONTINUE - RETURN -* -* End of CLAGGE -* - END diff --git a/testing/lin/clagsy.f b/testing/lin/clagsy.f deleted file mode 100644 index 0522d060097c4d5c6790857a684f8a8067b0dfc1..0000000000000000000000000000000000000000 --- a/testing/lin/clagsy.f +++ /dev/null @@ -1,260 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, K, LDA, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL D( * ) - COMPLEX A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* CLAGSY generates a complex symmetric matrix A, by pre- and post- -* multiplying a real diagonal matrix D with a random unitary matrix: -* A = U*D*U^T. The semi-bandwidth may then be reduced to k by -* additional unitary transformations. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* K (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= K <= N-1. -* -* D (input) REAL array, dimension (N) -* The diagonal elements of the diagonal matrix D. -* -* A (output) COMPLEX array, dimension (LDA,N) -* The generated n by n symmetric matrix A (the full matrix is -* stored). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= N. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) COMPLEX array, dimension (2*N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ZERO, ONE, HALF - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ), - $ ONE = ( 1.0E+0, 0.0E+0 ), - $ HALF = ( 0.5E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, II, J, JJ - REAL WN - COMPLEX ALPHA, TAU, WA, WB -* .. -* .. External Subroutines .. - EXTERNAL CAXPY, CGEMV, CGERC, CLACGV, CLARNV, CSCAL, - $ CSYMV, XERBLA -* .. -* .. External Functions .. - REAL SCNRM2 - COMPLEX CDOTC - EXTERNAL SCNRM2, CDOTC -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, REAL -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'CLAGSY', -INFO ) - RETURN - END IF -* -* initialize lower triangle of A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = J + 1, N - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, N - A( I, I ) = D( I ) - 30 CONTINUE -* -* Generate lower triangle of symmetric matrix -* - DO 60 I = N - 1, 1, -1 -* -* generate random reflection -* - CALL CLARNV( 3, ISEED, N-I+1, WORK ) - WN = SCNRM2( N-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL CSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply random reflection to A(i:n,i:n) from the left -* and the right -* -* compute y := tau * A * conjg(u) -* - CALL CLACGV( N-I+1, WORK, 1 ) - CALL CSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO, - $ WORK( N+1 ), 1 ) - CALL CLACGV( N-I+1, WORK, 1 ) -* -* compute v := y - 1/2 * tau * ( u, y ) * u -* - ALPHA = -HALF*TAU*CDOTC( N-I+1, WORK, 1, WORK( N+1 ), 1 ) - CALL CAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 ) -* -* apply the transformation as a rank-2 update to A(i:n,i:n) -* -* CALL CSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1, -* $ A( I, I ), LDA ) -* - DO 50 JJ = I, N - DO 40 II = JJ, N - A( II, JJ ) = A( II, JJ ) - - $ WORK( II-I+1 )*WORK( N+JJ-I+1 ) - - $ WORK( N+II-I+1 )*WORK( JJ-I+1 ) - 40 CONTINUE - 50 CONTINUE - 60 CONTINUE -* -* Reduce number of subdiagonals to K -* - DO 100 I = 1, N - 1 - K -* -* generate reflection to annihilate A(k+i+1:n,i) -* - WN = SCNRM2( N-K-I+1, A( K+I, I ), 1 ) - WA = ( WN / ABS( A( K+I, I ) ) )*A( K+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( K+I, I ) + WA - CALL CSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 ) - A( K+I, I ) = ONE - TAU = REAL( WB / WA ) - END IF -* -* apply reflection to A(k+i:n,i+1:k+i-1) from the left -* - CALL CGEMV( 'Conjugate transpose', N-K-I+1, K-1, ONE, - $ A( K+I, I+1 ), LDA, A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL CGERC( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1, - $ A( K+I, I+1 ), LDA ) -* -* apply reflection to A(k+i:n,k+i:n) from the left and the right -* -* compute y := tau * A * conjg(u) -* - CALL CLACGV( N-K-I+1, A( K+I, I ), 1 ) - CALL CSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL CLACGV( N-K-I+1, A( K+I, I ), 1 ) -* -* compute v := y - 1/2 * tau * ( u, y ) * u -* - ALPHA = -HALF*TAU*CDOTC( N-K-I+1, A( K+I, I ), 1, WORK, 1 ) - CALL CAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 ) -* -* apply symmetric rank-2 update to A(k+i:n,k+i:n) -* -* CALL CSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1, -* $ A( K+I, K+I ), LDA ) -* - DO 80 JJ = K + I, N - DO 70 II = JJ, N - A( II, JJ ) = A( II, JJ ) - A( II, I )*WORK( JJ-K-I+1 ) - - $ WORK( II-K-I+1 )*A( JJ, I ) - 70 CONTINUE - 80 CONTINUE -* - A( K+I, I ) = -WA - DO 90 J = K + I + 1, N - A( J, I ) = ZERO - 90 CONTINUE - 100 CONTINUE -* -* Store full symmetric matrix -* - DO 120 J = 1, N - DO 110 I = J + 1, N - A( J, I ) = A( I, J ) - 110 CONTINUE - 120 CONTINUE - RETURN -* -* End of CLAGSY -* - END diff --git a/testing/lin/claipd.f b/testing/lin/claipd.f deleted file mode 100644 index cef6fa9fc171952a8c2d2bf5fe2376a9993c79a4..0000000000000000000000000000000000000000 --- a/testing/lin/claipd.f +++ /dev/null @@ -1,110 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAIPD( N, A, INDA, VINDA ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INDA, N, VINDA -* .. -* .. Array Arguments .. - COMPLEX A( * ) -* .. -* -* Purpose -* ======= -* -* CLAIPD sets the imaginary part of the diagonal elements of a complex -* matrix A to a large value. This is used to test LAPACK routines for -* complex Hermitian matrices, which are not supposed to access or use -* the imaginary parts of the diagonals. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of diagonal elements of A. -* -* A (input/output) COMPLEX array, dimension -* (1+(N-1)*INDA+(N-2)*VINDA) -* On entry, the complex (Hermitian) matrix A. -* On exit, the imaginary parts of the diagonal elements are set -* to BIGNUM = EPS / SAFMIN, where EPS is the machine epsilon and -* SAFMIN is the safe minimum. -* -* INDA (input) INTEGER -* The increment between A(1) and the next diagonal element of A. -* Typical values are -* = LDA+1: square matrices with leading dimension LDA -* = 2: packed upper triangular matrix, starting at A(1,1) -* = N: packed lower triangular matrix, starting at A(1,1) -* -* VINDA (input) INTEGER -* The change in the diagonal increment between columns of A. -* Typical values are -* = 0: no change, the row and column increments in A are fixed -* = 1: packed upper triangular matrix -* = -1: packed lower triangular matrix -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, IA, IXA - REAL BIGNUM -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL -* .. -* .. Executable Statements .. -* - BIGNUM = SLAMCH( 'Epsilon' ) / SLAMCH( 'Safe minimum' ) - IA = 1 - IXA = INDA - DO 10 I = 1, N - A( IA ) = CMPLX( REAL( A( IA ) ), BIGNUM ) - IA = IA + IXA - IXA = IXA + VINDA - 10 CONTINUE - RETURN - END diff --git a/testing/lin/clanhe.f b/testing/lin/clanhe.f deleted file mode 100644 index 534357bc5decd9b7cbc32502baf0ec0f1f86ef0a..0000000000000000000000000000000000000000 --- a/testing/lin/clanhe.f +++ /dev/null @@ -1,224 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER NORM, UPLO - INTEGER LDA, N -* .. -* .. Array Arguments .. - REAL WORK( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLANHE returns the value of the one norm, or the Frobenius norm, or -* the infinity norm, or the element of largest absolute value of a -* complex hermitian matrix A. -* -* Description -* =========== -* -* CLANHE returns the value -* -* CLANHE = ( max(abs(A(i,j))), NORM = 'M' or 'm' -* ( -* ( norm1(A), NORM = '1', 'O' or 'o' -* ( -* ( normI(A), NORM = 'I' or 'i' -* ( -* ( normF(A), NORM = 'F', 'f', 'E' or 'e' -* -* where norm1 denotes the one norm of a matrix (maximum column sum), -* normI denotes the infinity norm of a matrix (maximum row sum) and -* normF denotes the Frobenius norm of a matrix (square root of sum of -* squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. -* -* Arguments -* ========= -* -* NORM (input) CHARACTER*1 -* Specifies the value to be returned in CLANHE as described -* above. -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* hermitian matrix A is to be referenced. -* = 'U': Upper triangular part of A is referenced -* = 'L': Lower triangular part of A is referenced -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. When N = 0, CLANHE is -* set to zero. -* -* A (input) COMPLEX array, dimension (LDA,N) -* 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. Note that the imaginary parts of the diagonal -* elements need not be set and are assumed to be zero. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* WORK (workspace) REAL array, dimension (MAX(1,LWORK)), -* where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, -* WORK is not referenced. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL ABSA, SCALE, SUM, VALUE -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL CLASSQ -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, REAL, SQRT -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 ) THEN - VALUE = ZERO - ELSE IF( LSAME( NORM, 'M' ) ) THEN -* -* Find max(abs(A(i,j))). -* - VALUE = ZERO - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) - 10 CONTINUE - VALUE = MAX( VALUE, ABS( REAL( A( J, J ) ) ) ) - 20 CONTINUE - ELSE - DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( REAL( A( J, J ) ) ) ) - DO 30 I = J + 1, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. - $ ( NORM.EQ.'1' ) ) THEN -* -* Find normI(A) ( = norm1(A), since A is hermitian). -* - VALUE = ZERO - IF( LSAME( UPLO, 'U' ) ) THEN - DO 60 J = 1, N - SUM = ZERO - DO 50 I = 1, J - 1 - ABSA = ABS( A( I, J ) ) - SUM = SUM + ABSA - WORK( I ) = WORK( I ) + ABSA - 50 CONTINUE - WORK( J ) = SUM + ABS( REAL( A( J, J ) ) ) - 60 CONTINUE - DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) - 70 CONTINUE - ELSE - DO 80 I = 1, N - WORK( I ) = ZERO - 80 CONTINUE - DO 100 J = 1, N - SUM = WORK( J ) + ABS( REAL( A( J, J ) ) ) - DO 90 I = J + 1, N - ABSA = ABS( A( I, J ) ) - SUM = SUM + ABSA - WORK( I ) = WORK( I ) + ABSA - 90 CONTINUE - VALUE = MAX( VALUE, SUM ) - 100 CONTINUE - END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN -* -* Find normF(A). -* - SCALE = ZERO - SUM = ONE - IF( LSAME( UPLO, 'U' ) ) THEN - DO 110 J = 2, N - CALL CLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) - 110 CONTINUE - ELSE - DO 120 J = 1, N - 1 - CALL CLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) - 120 CONTINUE - END IF - SUM = 2*SUM - DO 130 I = 1, N - IF( REAL( A( I, I ) ).NE.ZERO ) THEN - ABSA = ABS( REAL( A( I, I ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA - ELSE - SUM = SUM + ( ABSA / SCALE )**2 - END IF - END IF - 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) - END IF -* - CLANHE = VALUE - RETURN -* -* End of CLANHE -* - END diff --git a/testing/lin/claqge.f b/testing/lin/claqge.f deleted file mode 100644 index 8a466cc42a86c61fac014f1c9655fac489c5f73a..0000000000000000000000000000000000000000 --- a/testing/lin/claqge.f +++ /dev/null @@ -1,192 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED - INTEGER LDA, M, N - REAL AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - REAL C( * ), R( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLAQGE equilibrates a general M by N matrix A using the row and -* column scaling factors in the vectors R and C. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the M by N matrix A. -* On exit, the equilibrated matrix. See EQUED for the form of -* the equilibrated matrix. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(M,1). -* -* R (input) REAL array, dimension (M) -* The row scale factors for A. -* -* C (input) REAL array, dimension (N) -* The column scale factors for A. -* -* ROWCND (input) REAL -* Ratio of the smallest R(i) to the largest R(i). -* -* COLCND (input) REAL -* Ratio of the smallest C(i) to the largest C(i). -* -* AMAX (input) REAL -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration -* = 'R': Row equilibration, i.e., A has been premultiplied by -* diag(R). -* = 'C': Column equilibration, i.e., A has been postmultiplied -* by diag(C). -* = 'B': Both row and column equilibration, i.e., A has been -* replaced by diag(R) * A * diag(C). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if row or column scaling -* should be done based on the ratio of the row or column scaling -* factors. If ROWCND < THRESH, row scaling is done, and if -* COLCND < THRESH, column scaling is done. -* -* LARGE and SMALL are threshold values used to decide if row scaling -* should be done based on the absolute size of the largest matrix -* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, THRESH - PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL CJ, LARGE, SMALL -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( M.LE.0 .OR. N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) - $ THEN -* -* No row scaling -* - IF( COLCND.GE.THRESH ) THEN -* -* No column scaling -* - EQUED = 'N' - ELSE -* -* Column scaling -* - DO 20 J = 1, N - CJ = C( J ) - DO 10 I = 1, M - A( I, J ) = CJ*A( I, J ) - 10 CONTINUE - 20 CONTINUE - EQUED = 'C' - END IF - ELSE IF( COLCND.GE.THRESH ) THEN -* -* Row scaling, no column scaling -* - DO 40 J = 1, N - DO 30 I = 1, M - A( I, J ) = R( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - EQUED = 'R' - ELSE -* -* Row and column scaling -* - DO 60 J = 1, N - CJ = C( J ) - DO 50 I = 1, M - A( I, J ) = CJ*R( I )*A( I, J ) - 50 CONTINUE - 60 CONTINUE - EQUED = 'B' - END IF -* - RETURN -* -* End of CLAQGE -* - END diff --git a/testing/lin/claqhe.f b/testing/lin/claqhe.f deleted file mode 100644 index af6da2344330c0316effedd41ea15659476468b0..0000000000000000000000000000000000000000 --- a/testing/lin/claqhe.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - REAL AMAX, SCOND -* .. -* .. Array Arguments .. - REAL S( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLAQHE equilibrates a Hermitian matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) REAL array, dimension (N) -* The scale factors for A. -* -* SCOND (input) REAL -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) REAL -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, THRESH - PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH - EXTERNAL LSAME, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - 1 - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - A( J, J ) = CJ*CJ*REAL( A( J, J ) ) - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - A( J, J ) = CJ*CJ*REAL( A( J, J ) ) - DO 30 I = J + 1, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of CLAQHE -* - END diff --git a/testing/lin/claqsy.f b/testing/lin/claqsy.f deleted file mode 100644 index 1c5d52d52ddfd65e5366a8b8a8cce6d94659ee24..0000000000000000000000000000000000000000 --- a/testing/lin/claqsy.f +++ /dev/null @@ -1,179 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - REAL AMAX, SCOND -* .. -* .. Array Arguments .. - REAL S( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLAQSY equilibrates a symmetric matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the symmetric 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) REAL array, dimension (N) -* The scale factors for A. -* -* SCOND (input) REAL -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) REAL -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, THRESH - PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH - EXTERNAL LSAME, SLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - DO 30 I = J, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of CLAQSY -* - END diff --git a/testing/lin/clarhs.f b/testing/lin/clarhs.f deleted file mode 100644 index 22165f3a3ca9f9fef93d640ea72ce053c215d131..0000000000000000000000000000000000000000 --- a/testing/lin/clarhs.f +++ /dev/null @@ -1,390 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, - $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CLARHS chooses a set of NRHS random solution vectors and sets -* up the right hand sides for the linear system -* op( A ) * X = B, -* where op( A ) may be A, A^T (transpose of A), or A^H (conjugate -* transpose of A). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The type of the complex matrix A. PATH may be given in any -* combination of upper and lower case. Valid paths include -* xGE: General m x n matrix -* xGB: General banded matrix -* xPO: Hermitian positive definite, 2-D storage -* xPP: Hermitian positive definite packed -* xPB: Hermitian positive definite banded -* xHE: Hermitian indefinite, 2-D storage -* xHP: Hermitian indefinite packed -* xHB: Hermitian indefinite banded -* xSY: Symmetric indefinite, 2-D storage -* xSP: Symmetric indefinite packed -* xSB: Symmetric indefinite banded -* xTR: Triangular -* xTP: Triangular packed -* xTB: Triangular banded -* xQR: General m x n matrix -* xLQ: General m x n matrix -* xQL: General m x n matrix -* xRQ: General m x n matrix -* where the leading character indicates the precision. -* -* XTYPE (input) CHARACTER*1 -* Specifies how the exact solution X will be determined: -* = 'N': New solution; generate a random X. -* = 'C': Computed; use value of X on entry. -* -* UPLO (input) CHARACTER*1 -* Used only if A is symmetric or triangular; specifies whether -* the upper or lower triangular part of the matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Used only if A is nonsymmetric; specifies the operation -* applied to the matrix A. -* = 'N': B := A * X -* = 'T': B := A^T * X -* = 'C': B := A^H * X -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* Used only if A is a band matrix; specifies the number of -* subdiagonals of A if A is a general band matrix or if A is -* symmetric or triangular and UPLO = 'L'; specifies the number -* of superdiagonals of A if A is symmetric or triangular and -* UPLO = 'U'. 0 <= KL <= M-1. -* -* KU (input) INTEGER -* Used only if A is a general band matrix or if A is -* triangular. -* -* If PATH = xGB, specifies the number of superdiagonals of A, -* and 0 <= KU <= N-1. -* -* If PATH = xTR, xTP, or xTB, specifies whether or not the -* matrix has unit diagonal: -* = 1: matrix has non-unit diagonal (default) -* = 2: matrix has unit diagonal -* -* NRHS (input) INTEGER -* The number of right hand side vectors in the system A*X = B. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The test matrix whose type is given by PATH. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* If PATH = xGB, LDA >= KL+KU+1. -* If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. -* Otherwise, LDA >= max(1,M). -* -* X (input or output) COMPLEX array, dimension (LDX,NRHS) -* On entry, if XTYPE = 'C' (for 'Computed'), then X contains -* the exact solution to the system of linear equations. -* On exit, if XTYPE = 'N' (for 'New'), then X is initialized -* with random values. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). -* -* B (output) COMPLEX array, dimension (LDB,NRHS) -* The right hand side vector(s) for the system of equations, -* computed from B = op(A) * X, where op(A) is determined by -* TRANS. -* -* LDB (input) INTEGER -* The leading dimension of the array B. If TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). -* -* ISEED (input/output) INTEGER array, dimension (4) -* The seed vector for the random number generator (used in -* CLATMS). Modified on exit. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE, ZERO - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), - $ ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI - CHARACTER C1, DIAG - CHARACTER*2 C2 - INTEGER J, MB, NX -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL CGBMV, CGEMM, CHBMV, CHEMM, CHPMV, CLACPY, - $ CLARNV, CSBMV, CSPMV, CSYMM, CTBMV, CTPMV, - $ CTRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) - NOTRAN = .NOT.TRAN - GEN = LSAME( PATH( 2: 2 ), 'G' ) - QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) - SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. - $ LSAME( PATH( 2: 2 ), 'S' ) .OR. LSAME( PATH( 2: 2 ), 'H' ) - TRI = LSAME( PATH( 2: 2 ), 'T' ) - BAND = LSAME( PATH( 3: 3 ), 'B' ) - IF( .NOT.LSAME( C1, 'Complex precision' ) ) THEN - INFO = -1 - ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) - $ THEN - INFO = -2 - ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. - $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN - INFO = -3 - ELSE IF( ( GEN.OR.QRS ) .AND. - $ .NOT.( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN - INFO = -4 - ELSE IF( M.LT.0 ) THEN - INFO = -5 - ELSE IF( N.LT.0 ) THEN - INFO = -6 - ELSE IF( BAND .AND. KL.LT.0 ) THEN - INFO = -7 - ELSE IF( BAND .AND. KU.LT.0 ) THEN - INFO = -8 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -9 - ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. - $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. - $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN - INFO = -11 - ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. - $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN - INFO = -13 - ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. - $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN - INFO = -15 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLARHS', -INFO ) - RETURN - END IF -* -* Initialize X to NRHS random vectors unless XTYPE = 'C'. -* - IF( TRAN ) THEN - NX = M - MB = N - ELSE - NX = N - MB = M - END IF - IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN - DO 10 J = 1, NRHS - CALL CLARNV( 2, ISEED, N, X( 1, J ) ) - 10 CONTINUE - END IF -* -* Multiply X by op( A ) using an appropriate -* matrix multiply routine. -* - IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. - $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. - $ LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* General matrix -* - CALL CGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, - $ ZERO, B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'HE' ) ) THEN -* -* Hermitian matrix, 2-D storage -* - CALL CHEMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN -* -* Symmetric matrix, 2-D storage -* - CALL CSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* General matrix, band storage -* - DO 20 J = 1, NRHS - CALL CGBMV( TRANS, M, N, KL, KU, ONE, A, LDA, X( 1, J ), 1, - $ ZERO, B( 1, J ), 1 ) - 20 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) .OR. LSAMEN( 2, C2, 'HB' ) ) THEN -* -* Hermitian matrix, band storage -* - DO 30 J = 1, NRHS - CALL CHBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 30 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'SB' ) ) THEN -* -* Symmetric matrix, band storage -* - DO 40 J = 1, NRHS - CALL CSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 40 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'HP' ) ) THEN -* -* Hermitian matrix, packed storage -* - DO 50 J = 1, NRHS - CALL CHPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 50 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN -* -* Symmetric matrix, packed storage -* - DO 60 J = 1, NRHS - CALL CSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 60 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN -* -* Triangular matrix. Note that for triangular matrices, -* KU = 1 => non-unit triangular -* KU = 2 => unit triangular -* - CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - CALL CTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, - $ LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN -* -* Triangular matrix, packed storage -* - CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 70 J = 1, NRHS - CALL CTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) - 70 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* Triangular matrix, banded storage -* - CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 80 J = 1, NRHS - CALL CTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) - 80 CONTINUE -* - ELSE -* -* If none of the above, set INFO = -1 and return -* - INFO = -1 - CALL XERBLA( 'CLARHS', -INFO ) - END IF -* - RETURN -* -* End of CLARHS -* - END diff --git a/testing/lin/clarnd.f b/testing/lin/clarnd.f deleted file mode 100644 index 81ddcc7825aefa261210a8b2f0c8fe18bbb87745..0000000000000000000000000000000000000000 --- a/testing/lin/clarnd.f +++ /dev/null @@ -1,137 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - COMPLEX FUNCTION CLARND( IDIST, ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* CLARND returns a random complex number from a uniform or normal -* distribution. -* -* Arguments -* ========= -* -* IDIST (input) INTEGER -* Specifies the distribution of the random numbers: -* = 1: real and imaginary parts each uniform (0,1) -* = 2: real and imaginary parts each uniform (-1,1) -* = 3: real and imaginary parts each normal (0,1) -* = 4: uniformly distributed on the disc abs(z) <= 1 -* = 5: uniformly distributed on the circle abs(z) = 1 -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine calls the auxiliary routine SLARAN to generate a random -* real number from a uniform (0,1) distribution. The Box-Muller method -* is used to transform numbers from a uniform to a normal distribution. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, TWO - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) - REAL TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) -* .. -* .. Local Scalars .. - REAL T1, T2 -* .. -* .. External Functions .. - REAL SLARAN - EXTERNAL SLARAN -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, EXP, LOG, SQRT -* .. -* .. Executable Statements .. -* -* Generate a pair of real random numbers from a uniform (0,1) -* distribution -* - T1 = SLARAN( ISEED ) - T2 = SLARAN( ISEED ) -* - IF( IDIST.EQ.1 ) THEN -* -* real and imaginary parts each uniform (0,1) -* - CLARND = CMPLX( T1, T2 ) - ELSE IF( IDIST.EQ.2 ) THEN -* -* real and imaginary parts each uniform (-1,1) -* - CLARND = CMPLX( TWO*T1-ONE, TWO*T2-ONE ) - ELSE IF( IDIST.EQ.3 ) THEN -* -* real and imaginary parts each normal (0,1) -* - CLARND = SQRT( -TWO*LOG( T1 ) )*EXP( CMPLX( ZERO, TWOPI*T2 ) ) - ELSE IF( IDIST.EQ.4 ) THEN -* -* uniform distribution on the unit disc abs(z) <= 1 -* - CLARND = SQRT( T1 )*EXP( CMPLX( ZERO, TWOPI*T2 ) ) - ELSE IF( IDIST.EQ.5 ) THEN -* -* uniform distribution on the unit circle abs(z) = 1 -* - CLARND = EXP( CMPLX( ZERO, TWOPI*T2 ) ) - END IF - RETURN -* -* End of CLARND -* - END diff --git a/testing/lin/claror.f b/testing/lin/claror.f deleted file mode 100644 index a576249c4c98d7e3975873d9f44cb8022be6ae84..0000000000000000000000000000000000000000 --- a/testing/lin/claror.f +++ /dev/null @@ -1,321 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER INIT, SIDE - INTEGER INFO, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* CLAROR pre- or post-multiplies an M by N matrix A by a random -* unitary matrix U, overwriting A. A may optionally be -* initialized to the identity matrix before multiplying by U. -* U is generated using the method of G.W. Stewart -* ( SIAM J. Numer. Anal. 17, 1980, pp. 403-409 ). -* (BLAS-2 version) -* -* Arguments -* ========= -* -* SIDE - CHARACTER*1 -* SIDE specifies whether A is multiplied on the left or right -* by U. -* SIDE = 'L' Multiply A on the left (premultiply) by U -* SIDE = 'R' Multiply A on the right (postmultiply) by U* -* SIDE = 'C' Multiply A on the left by U and the right by U* -* SIDE = 'T' Multiply A on the left by U and the right by U' -* Not modified. -* -* INIT - CHARACTER*1 -* INIT specifies whether or not A should be initialized to -* the identity matrix. -* INIT = 'I' Initialize A to (a section of) the -* identity matrix before applying U. -* INIT = 'N' No initialization. Apply U to the -* input matrix A. -* -* INIT = 'I' may be used to generate square (i.e., unitary) -* or rectangular orthogonal matrices (orthogonality being -* in the sense of CDOTC): -* -* For square matrices, M=N, and SIDE many be either 'L' or -* 'R'; the rows will be orthogonal to each other, as will the -* columns. -* For rectangular matrices where M < N, SIDE = 'R' will -* produce a dense matrix whose rows will be orthogonal and -* whose columns will not, while SIDE = 'L' will produce a -* matrix whose rows will be orthogonal, and whose first M -* columns will be orthogonal, the remaining columns being -* zero. -* For matrices where M > N, just use the previous -* explaination, interchanging 'L' and 'R' and "rows" and -* "columns". -* -* Not modified. -* -* M - INTEGER -* Number of rows of A. Not modified. -* -* N - INTEGER -* Number of columns of A. Not modified. -* -* A - COMPLEX array, dimension ( LDA, N ) -* Input and output array. Overwritten by U A ( if SIDE = 'L' ) -* or by A U ( if SIDE = 'R' ) -* or by U A U* ( if SIDE = 'C') -* or by U A U' ( if SIDE = 'T') on exit. -* -* LDA - INTEGER -* Leading dimension of A. Must be at least MAX ( 1, M ). -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The array elements should be between 0 and 4095; -* if not they will be reduced mod 4096. Also, ISEED(4) must -* be odd. The random number generator uses a linear -* congruential sequence limited to small integers, and so -* should produce machine independent random numbers. The -* values of ISEED are changed on exit, and can be used in the -* next call to CLAROR to continue the same random number -* sequence. -* Modified. -* -* X - COMPLEX array, dimension ( 3*MAX( M, N ) ) -* Workspace. Of length: -* 2*M + N if SIDE = 'L', -* 2*N + M if SIDE = 'R', -* 3*N if SIDE = 'C' or 'T'. -* Modified. -* -* INFO - INTEGER -* An error flag. It is set to: -* 0 if no error. -* 1 if CLARND returned a bad random number (installation -* problem) -* -1 if SIDE is not L, R, C, or T. -* -3 if M is negative. -* -4 if N is negative or if SIDE is C or T and N is not equal -* to M. -* -6 if LDA is less than M. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, TOOSML - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, - $ TOOSML = 1.0E-20 ) - COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), - $ CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM - REAL FACTOR, XABS, XNORM - COMPLEX CSIGN, XNORMS -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SCNRM2 - COMPLEX CLARND - EXTERNAL LSAME, SCNRM2, CLARND -* .. -* .. External Subroutines .. - EXTERNAL CGEMV, CGERC, CLACGV, CLASET, CSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, CMPLX, CONJG -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* - ITYPE = 0 - IF( LSAME( SIDE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( SIDE, 'R' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( SIDE, 'C' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( SIDE, 'T' ) ) THEN - ITYPE = 4 - END IF -* -* Check for argument errors. -* - INFO = 0 - IF( ITYPE.EQ.0 ) THEN - INFO = -1 - ELSE IF( M.LT.0 ) THEN - INFO = -3 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN - INFO = -4 - ELSE IF( LDA.LT.M ) THEN - INFO = -6 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLAROR', -INFO ) - RETURN - END IF -* - IF( ITYPE.EQ.1 ) THEN - NXFRM = M - ELSE - NXFRM = N - END IF -* -* Initialize A to the identity matrix if desired -* - IF( LSAME( INIT, 'I' ) ) - $ CALL CLASET( 'Full', M, N, CZERO, CONE, A, LDA ) -* -* If no rotation possible, still multiply by -* a random complex number from the circle |x| = 1 -* -* 2) Compute Rotation by computing Householder -* Transformations H(2), H(3), ..., H(n). Note that the -* order in which they are computed is irrelevant. -* - DO 40 J = 1, NXFRM - X( J ) = CZERO - 40 CONTINUE -* - DO 60 IXFRM = 2, NXFRM - KBEG = NXFRM - IXFRM + 1 -* -* Generate independent normal( 0, 1 ) random numbers -* - DO 50 J = KBEG, NXFRM - X( J ) = CLARND( 3, ISEED ) - 50 CONTINUE -* -* Generate a Householder transformation from the random vector X -* - XNORM = SCNRM2( IXFRM, X( KBEG ), 1 ) - XABS = ABS( X( KBEG ) ) - IF( XABS.NE.CZERO ) THEN - CSIGN = X( KBEG ) / XABS - ELSE - CSIGN = CONE - END IF - XNORMS = CSIGN*XNORM - X( NXFRM+KBEG ) = -CSIGN - FACTOR = XNORM*( XNORM+XABS ) - IF( ABS( FACTOR ).LT.TOOSML ) THEN - INFO = 1 - CALL XERBLA( 'CLAROR', -INFO ) - RETURN - ELSE - FACTOR = ONE / FACTOR - END IF - X( KBEG ) = X( KBEG ) + XNORMS -* -* Apply Householder transformation to A -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN -* -* Apply H(k) on the left of A -* - CALL CGEMV( 'C', IXFRM, N, CONE, A( KBEG, 1 ), LDA, - $ X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 ) - CALL CGERC( IXFRM, N, -CMPLX( FACTOR ), X( KBEG ), 1, - $ X( 2*NXFRM+1 ), 1, A( KBEG, 1 ), LDA ) -* - END IF -* - IF( ITYPE.GE.2 .AND. ITYPE.LE.4 ) THEN -* -* Apply H(k)* (or H(k)') on the right of A -* - IF( ITYPE.EQ.4 ) THEN - CALL CLACGV( IXFRM, X( KBEG ), 1 ) - END IF -* - CALL CGEMV( 'N', M, IXFRM, CONE, A( 1, KBEG ), LDA, - $ X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 ) - CALL CGERC( M, IXFRM, -CMPLX( FACTOR ), X( 2*NXFRM+1 ), 1, - $ X( KBEG ), 1, A( 1, KBEG ), LDA ) -* - END IF - 60 CONTINUE -* - X( 1 ) = CLARND( 3, ISEED ) - XABS = ABS( X( 1 ) ) - IF( XABS.NE.ZERO ) THEN - CSIGN = X( 1 ) / XABS - ELSE - CSIGN = CONE - END IF - X( 2*NXFRM ) = CSIGN -* -* Scale the matrix A by D. -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN - DO 70 IROW = 1, M - CALL CSCAL( N, CONJG( X( NXFRM+IROW ) ), A( IROW, 1 ), LDA ) - 70 CONTINUE - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN - DO 80 JCOL = 1, N - CALL CSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 ) - 80 CONTINUE - END IF -* - IF( ITYPE.EQ.4 ) THEN - DO 90 JCOL = 1, N - CALL CSCAL( M, CONJG( X( NXFRM+JCOL ) ), A( 1, JCOL ), 1 ) - 90 CONTINUE - END IF - RETURN -* -* End of CLAROR -* - END diff --git a/testing/lin/clarot.f b/testing/lin/clarot.f deleted file mode 100644 index 3c84701bd0be396c7eb551448f23e9a04a24ef75..0000000000000000000000000000000000000000 --- a/testing/lin/clarot.f +++ /dev/null @@ -1,333 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, - $ XRIGHT ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL LLEFT, LRIGHT, LROWS - INTEGER LDA, NL - COMPLEX C, S, XLEFT, XRIGHT -* .. -* .. Array Arguments .. - COMPLEX A( * ) -* .. -* -* Purpose -* ======= -* -* CLAROT applies a (Givens) rotation to two adjacent rows or -* columns, where one element of the first and/or last column/row -* for use on matrices stored in some format other than GE, so -* that elements of the matrix may be used or modified for which -* no array element is provided. -* -* One example is a symmetric matrix in SB format (bandwidth=4), for -* which UPLO='L': Two adjacent rows will have the format: -* -* row j: * * * * * . . . . -* row j+1: * * * * * . . . . -* -* '*' indicates elements for which storage is provided, -* '.' indicates elements for which no storage is provided, but -* are not necessarily zero; their values are determined by -* symmetry. ' ' indicates elements which are necessarily zero, -* and have no storage provided. -* -* Those columns which have two '*'s can be handled by SROT. -* Those columns which have no '*'s can be ignored, since as long -* as the Givens rotations are carefully applied to preserve -* symmetry, their values are determined. -* Those columns which have one '*' have to be handled separately, -* by using separate variables "p" and "q": -* -* row j: * * * * * p . . . -* row j+1: q * * * * * . . . . -* -* The element p would have to be set correctly, then that column -* is rotated, setting p to its new value. The next call to -* CLAROT would rotate columns j and j+1, using p, and restore -* symmetry. The element q would start out being zero, and be -* made non-zero by the rotation. Later, rotations would presumably -* be chosen to zero q out. -* -* Typical Calling Sequences: rotating the i-th and (i+1)-st rows. -* ------- ------- --------- -* -* General dense matrix: -* -* CALL CLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, -* A(i,1),LDA, DUMMY, DUMMY) -* -* General banded matrix in GB format: -* -* j = MAX(1, i-KL ) -* NL = MIN( N, i+KU+1 ) + 1-j -* CALL CLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, -* A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,KL+1) ] -* -* Symmetric banded matrix in SY format, bandwidth K, -* lower triangle only: -* -* j = MAX(1, i-K ) -* NL = MIN( K+1, i ) + 1 -* CALL CLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, -* A(i,j), LDA, XLEFT, XRIGHT ) -* -* Same, but upper triangle only: -* -* NL = MIN( K+1, N-i ) + 1 -* CALL CLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, -* A(i,i), LDA, XLEFT, XRIGHT ) -* -* Symmetric banded matrix in SB format, bandwidth K, -* lower triangle only: -* -* [ same as for SY, except:] -* . . . . -* A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,K+1) ] -* -* Same, but upper triangle only: -* . . . -* A(K+1,i), LDA-1, XLEFT, XRIGHT ) -* -* Rotating columns is just the transpose of rotating rows, except -* for GB and SB: (rotating columns i and i+1) -* -* GB: -* j = MAX(1, i-KU ) -* NL = MIN( N, i+KL+1 ) + 1-j -* CALL CLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, -* A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* [note that KU+j+1-i is just MAX(1,KU+2-i)] -* -* SB: (upper triangle) -* -* . . . . . . -* A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* SB: (lower triangle) -* -* . . . . . . -* A(1,i),LDA-1, XTOP, XBOTTM ) -* -* Arguments -* ========= -* -* LROWS - LOGICAL -* If .TRUE., then CLAROT will rotate two rows. If .FALSE., -* then it will rotate two columns. -* Not modified. -* -* LLEFT - LOGICAL -* If .TRUE., then XLEFT will be used instead of the -* corresponding element of A for the first element in the -* second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) -* If .FALSE., then the corresponding element of A will be -* used. -* Not modified. -* -* LRIGHT - LOGICAL -* If .TRUE., then XRIGHT will be used instead of the -* corresponding element of A for the last element in the -* first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If -* .FALSE., then the corresponding element of A will be used. -* Not modified. -* -* NL - INTEGER -* The length of the rows (if LROWS=.TRUE.) or columns (if -* LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are -* used, the columns/rows they are in should be included in -* NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at -* least 2. The number of rows/columns to be rotated -* exclusive of those involving XLEFT and/or XRIGHT may -* not be negative, i.e., NL minus how many of LLEFT and -* LRIGHT are .TRUE. must be at least zero; if not, XERBLA -* will be called. -* Not modified. -* -* C, S - COMPLEX -* Specify the Givens rotation to be applied. If LROWS is -* true, then the matrix ( c s ) -* ( _ _ ) -* (-s c ) is applied from the left; -* if false, then the transpose (not conjugated) thereof is -* applied from the right. Note that in contrast to the -* output of CROTG or to most versions of CROT, both C and S -* are complex. For a Givens rotation, |C|**2 + |S|**2 should -* be 1, but this is not checked. -* Not modified. -* -* A - COMPLEX array. -* The array containing the rows/columns to be rotated. The -* first element of A should be the upper left element to -* be rotated. -* Read and modified. -* -* LDA - INTEGER -* The "effective" leading dimension of A. If A contains -* a matrix stored in GE, HE, or SY format, then this is just -* the leading dimension of A as dimensioned in the calling -* routine. If A contains a matrix stored in band (GB, HB, or -* SB) format, then this should be *one less* than the leading -* dimension used in the calling routine. Thus, if A were -* dimensioned A(LDA,*) in CLAROT, then A(1,j) would be the -* j-th element in the first of the two rows to be rotated, -* and A(2,j) would be the j-th in the second, regardless of -* how the array may be stored in the calling routine. [A -* cannot, however, actually be dimensioned thus, since for -* band format, the row number may exceed LDA, which is not -* legal FORTRAN.] -* If LROWS=.TRUE., then LDA must be at least 1, otherwise -* it must be at least NL minus the number of .TRUE. values -* in XLEFT and XRIGHT. -* Not modified. -* -* XLEFT - COMPLEX -* If LLEFT is .TRUE., then XLEFT will be used and modified -* instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) -* (if LROWS=.FALSE.). -* Read and modified. -* -* XRIGHT - COMPLEX -* If LRIGHT is .TRUE., then XRIGHT will be used and modified -* instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) -* (if LROWS=.FALSE.). -* Read and modified. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER IINC, INEXT, IX, IY, IYT, J, NT - COMPLEX TEMPX -* .. -* .. Local Arrays .. - COMPLEX XT( 2 ), YT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC CONJG -* .. -* .. Executable Statements .. -* -* Set up indices, arrays for ends -* - IF( LROWS ) THEN - IINC = LDA - INEXT = 1 - ELSE - IINC = 1 - INEXT = LDA - END IF -* - IF( LLEFT ) THEN - NT = 1 - IX = 1 + IINC - IY = 2 + LDA - XT( 1 ) = A( 1 ) - YT( 1 ) = XLEFT - ELSE - NT = 0 - IX = 1 - IY = 1 + INEXT - END IF -* - IF( LRIGHT ) THEN - IYT = 1 + INEXT + ( NL-1 )*IINC - NT = NT + 1 - XT( NT ) = XRIGHT - YT( NT ) = A( IYT ) - END IF -* -* Check for errors -* - IF( NL.LT.NT ) THEN - CALL XERBLA( 'CLAROT', 4 ) - RETURN - END IF - IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN - CALL XERBLA( 'CLAROT', 8 ) - RETURN - END IF -* -* Rotate -* -* CROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S -* - DO 10 J = 0, NL - NT - 1 - TEMPX = C*A( IX+J*IINC ) + S*A( IY+J*IINC ) - A( IY+J*IINC ) = -CONJG( S )*A( IX+J*IINC ) + - $ CONJG( C )*A( IY+J*IINC ) - A( IX+J*IINC ) = TEMPX - 10 CONTINUE -* -* CROT( NT, XT,1, YT,1, C, S ) with complex C, S -* - DO 20 J = 1, NT - TEMPX = C*XT( J ) + S*YT( J ) - YT( J ) = -CONJG( S )*XT( J ) + CONJG( C )*YT( J ) - XT( J ) = TEMPX - 20 CONTINUE -* -* Stuff values back into XLEFT, XRIGHT, etc. -* - IF( LLEFT ) THEN - A( 1 ) = XT( 1 ) - XLEFT = YT( 1 ) - END IF -* - IF( LRIGHT ) THEN - XRIGHT = XT( NT ) - A( IYT ) = YT( NT ) - END IF -* - RETURN -* -* End of CLAROT -* - END diff --git a/testing/lin/clartg.f b/testing/lin/clartg.f deleted file mode 100644 index 460b5c255e08ea54e8c2ba000057922dad14bb33..0000000000000000000000000000000000000000 --- a/testing/lin/clartg.f +++ /dev/null @@ -1,232 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - REAL CS - COMPLEX F, G, R, SN -* .. -* -* Purpose -* ======= -* -* CLARTG generates a plane rotation so that -* -* [ CS SN ] [ F ] [ R ] -* [ __ ] . [ ] = [ ] where CS**2 + |SN|**2 = 1. -* [ -SN CS ] [ G ] [ 0 ] -* -* This is a faster version of the BLAS1 routine CROTG, except for -* the following differences: -* F and G are unchanged on return. -* If G=0, then CS=1 and SN=0. -* If F=0, then CS=0 and SN is chosen so that R is real. -* -* Arguments -* ========= -* -* F (input) COMPLEX -* The first component of vector to be rotated. -* -* G (input) COMPLEX -* The second component of vector to be rotated. -* -* CS (output) REAL -* The cosine of the rotation. -* -* SN (output) COMPLEX -* The sine of the rotation. -* -* R (output) COMPLEX -* The nonzero component of the rotated vector. -* -* Further Details -* ======= ======= -* -* 3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel -* -* This version has a few statements commented out for thread safety -* (machine parameters are computed on each entry). 10 feb 03, SJH. -* -* ===================================================================== -* -* .. Parameters .. - REAL TWO, ONE, ZERO - PARAMETER ( TWO = 2.0E+0, ONE = 1.0E+0, ZERO = 0.0E+0 ) - COMPLEX CZERO - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - REAL D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN, - $ SAFMN2, SAFMX2, SCALE - COMPLEX FF, FS, GS -* .. -* .. External Functions .. - REAL SLAMCH, SLAPY2 - EXTERNAL SLAMCH, SLAPY2 -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, LOG, MAX, REAL, - $ SQRT -* .. -* .. Statement Functions .. - REAL ABS1, ABSSQ -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Statement Function definitions .. - ABS1( FF ) = MAX( ABS( REAL( FF ) ), ABS( AIMAG( FF ) ) ) - ABSSQ( FF ) = REAL( FF )**2 + AIMAG( FF )**2 -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = SLAMCH( 'S' ) - EPS = SLAMCH( 'E' ) - SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( SLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - SCALE = MAX( ABS1( F ), ABS1( G ) ) - FS = F - GS = G - COUNT = 0 - IF( SCALE.GE.SAFMX2 ) THEN - 10 CONTINUE - COUNT = COUNT + 1 - FS = FS*SAFMN2 - GS = GS*SAFMN2 - SCALE = SCALE*SAFMN2 - IF( SCALE.GE.SAFMX2 ) - $ GO TO 10 - ELSE IF( SCALE.LE.SAFMN2 ) THEN - IF( G.EQ.CZERO ) THEN - CS = ONE - SN = CZERO - R = F - RETURN - END IF - 20 CONTINUE - COUNT = COUNT - 1 - FS = FS*SAFMX2 - GS = GS*SAFMX2 - SCALE = SCALE*SAFMX2 - IF( SCALE.LE.SAFMN2 ) - $ GO TO 20 - END IF - F2 = ABSSQ( FS ) - G2 = ABSSQ( GS ) - IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN -* -* This is a rare case: F is very small. -* - IF( F.EQ.CZERO ) THEN - CS = ZERO - R = SLAPY2( REAL( G ), AIMAG( G ) ) -* Do complex/real division explicitly with two real divisions - D = SLAPY2( REAL( GS ), AIMAG( GS ) ) - SN = CMPLX( REAL( GS ) / D, -AIMAG( GS ) / D ) - RETURN - END IF - F2S = SLAPY2( REAL( FS ), AIMAG( FS ) ) -* G2 and G2S are accurate -* G2 is at least SAFMIN, and G2S is at least SAFMN2 - G2S = SQRT( G2 ) -* Error in CS from underflow in F2S is at most -* UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS -* If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN, -* and so CS .lt. sqrt(SAFMIN) -* If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN -* and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS) -* Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S - CS = F2S / G2S -* Make sure abs(FF) = 1 -* Do complex/real division explicitly with 2 real divisions - IF( ABS1( F ).GT.ONE ) THEN - D = SLAPY2( REAL( F ), AIMAG( F ) ) - FF = CMPLX( REAL( F ) / D, AIMAG( F ) / D ) - ELSE - DR = SAFMX2*REAL( F ) - DI = SAFMX2*AIMAG( F ) - D = SLAPY2( DR, DI ) - FF = CMPLX( DR / D, DI / D ) - END IF - SN = FF*CMPLX( REAL( GS ) / G2S, -AIMAG( GS ) / G2S ) - R = CS*F + SN*G - ELSE -* -* This is the most common case. -* Neither F2 nor F2/G2 are less than SAFMIN -* F2S cannot overflow, and it is accurate -* - F2S = SQRT( ONE+G2 / F2 ) -* Do the F2S(real)*FS(complex) multiply with two real multiplies - R = CMPLX( F2S*REAL( FS ), F2S*AIMAG( FS ) ) - CS = ONE / F2S - D = F2 + G2 -* Do complex/real division explicitly with two real divisions - SN = CMPLX( REAL( R ) / D, AIMAG( R ) / D ) - SN = SN*CONJG( GS ) - IF( COUNT.NE.0 ) THEN - IF( COUNT.GT.0 ) THEN - DO 30 I = 1, COUNT - R = R*SAFMX2 - 30 CONTINUE - ELSE - DO 40 I = 1, -COUNT - R = R*SAFMN2 - 40 CONTINUE - END IF - END IF - END IF - RETURN -* -* End of CLARTG -* - END diff --git a/testing/lin/clascl.f b/testing/lin/clascl.f deleted file mode 100644 index 326288c965c9d86a11c945e4225f89a1ddf30849..0000000000000000000000000000000000000000 --- a/testing/lin/clascl.f +++ /dev/null @@ -1,320 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TYPE - INTEGER INFO, KL, KU, LDA, M, N - REAL CFROM, CTO -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLASCL multiplies the M by N complex matrix A by the real scalar -* CTO/CFROM. This is done without over/underflow as long as the final -* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that -* A may be full, upper triangular, lower triangular, upper Hessenberg, -* or banded. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*1 -* TYPE indices the storage type of the input matrix. -* = 'G': A is a full matrix. -* = 'L': A is a lower triangular matrix. -* = 'U': A is an upper triangular matrix. -* = 'H': A is an upper Hessenberg matrix. -* = 'B': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the lower -* half stored. -* = 'Q': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the upper -* half stored. -* = 'Z': A is a band matrix with lower bandwidth KL and upper -* bandwidth KU. -* -* KL (input) INTEGER -* The lower bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* KU (input) INTEGER -* The upper bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* CFROM (input) REAL -* CTO (input) REAL -* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed -* without over/underflow if the final result CTO*A(I,J)/CFROM -* can be represented without over/underflow. CFROM must be -* nonzero. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* The matrix to be multiplied by CTO/CFROM. See TYPE for the -* storage type. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* INFO (output) INTEGER -* 0 - successful exit -* <0 - if INFO = -i, the i-th argument had an illegal value. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - INTEGER I, ITYPE, J, K1, K2, K3, K4 - REAL BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME, SISNAN - REAL SLAMCH - EXTERNAL LSAME, SLAMCH, SISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 -* - IF( LSAME( TYPE, 'G' ) ) THEN - ITYPE = 0 - ELSE IF( LSAME( TYPE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( TYPE, 'U' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( TYPE, 'H' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( TYPE, 'B' ) ) THEN - ITYPE = 4 - ELSE IF( LSAME( TYPE, 'Q' ) ) THEN - ITYPE = 5 - ELSE IF( LSAME( TYPE, 'Z' ) ) THEN - ITYPE = 6 - ELSE - ITYPE = -1 - END IF -* - IF( ITYPE.EQ.-1 ) THEN - INFO = -1 - ELSE IF( CFROM.EQ.ZERO .OR. SISNAN(CFROM) ) THEN - INFO = -4 - ELSE IF( SISNAN(CTO) ) THEN - INFO = -5 - ELSE IF( M.LT.0 ) THEN - INFO = -6 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR. - $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN - INFO = -7 - ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN - INFO = -9 - ELSE IF( ITYPE.GE.4 ) THEN - IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN - INFO = -2 - ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR. - $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) ) - $ THEN - INFO = -3 - ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR. - $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR. - $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN - INFO = -9 - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLASCL', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* - CFROMC = CFROM - CTOC = CTO -* - 10 CONTINUE - CFROM1 = CFROMC*SMLNUM - IF( CFROM1.EQ.CFROMC ) THEN -! CFROMC is an inf. Multiply by a correctly signed zero for -! finite CTOC, or a NaN if CTOC is infinite. - MUL = CTOC / CFROMC - DONE = .TRUE. - CTO1 = CTOC - ELSE - CTO1 = CTOC / BIGNUM - IF( CTO1.EQ.CTOC ) THEN -! CTOC is either 0 or an inf. In both cases, CTOC itself -! serves as the correct multiplication factor. - MUL = CTOC - DONE = .TRUE. - CFROMC = ONE - ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN - MUL = SMLNUM - DONE = .FALSE. - CFROMC = CFROM1 - ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN - MUL = BIGNUM - DONE = .FALSE. - CTOC = CTO1 - ELSE - MUL = CTOC / CFROMC - DONE = .TRUE. - END IF - END IF -* - IF( ITYPE.EQ.0 ) THEN -* -* Full matrix -* - DO 30 J = 1, N - DO 20 I = 1, M - A( I, J ) = A( I, J )*MUL - 20 CONTINUE - 30 CONTINUE -* - ELSE IF( ITYPE.EQ.1 ) THEN -* -* Lower triangular matrix -* - DO 50 J = 1, N - DO 40 I = J, M - A( I, J ) = A( I, J )*MUL - 40 CONTINUE - 50 CONTINUE -* - ELSE IF( ITYPE.EQ.2 ) THEN -* -* Upper triangular matrix -* - DO 70 J = 1, N - DO 60 I = 1, MIN( J, M ) - A( I, J ) = A( I, J )*MUL - 60 CONTINUE - 70 CONTINUE -* - ELSE IF( ITYPE.EQ.3 ) THEN -* -* Upper Hessenberg matrix -* - DO 90 J = 1, N - DO 80 I = 1, MIN( J+1, M ) - A( I, J ) = A( I, J )*MUL - 80 CONTINUE - 90 CONTINUE -* - ELSE IF( ITYPE.EQ.4 ) THEN -* -* Lower half of a symmetric band matrix -* - K3 = KL + 1 - K4 = N + 1 - DO 110 J = 1, N - DO 100 I = 1, MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 100 CONTINUE - 110 CONTINUE -* - ELSE IF( ITYPE.EQ.5 ) THEN -* -* Upper half of a symmetric band matrix -* - K1 = KU + 2 - K3 = KU + 1 - DO 130 J = 1, N - DO 120 I = MAX( K1-J, 1 ), K3 - A( I, J ) = A( I, J )*MUL - 120 CONTINUE - 130 CONTINUE -* - ELSE IF( ITYPE.EQ.6 ) THEN -* -* Band matrix -* - K1 = KL + KU + 2 - K2 = KL + 1 - K3 = 2*KL + KU + 1 - K4 = KL + KU + 1 + M - DO 150 J = 1, N - DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 140 CONTINUE - 150 CONTINUE -* - END IF -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of CLASCL -* - END diff --git a/testing/lin/claset.f b/testing/lin/claset.f deleted file mode 100644 index 7d181a3e475006c6fde01cdbb148dde5b1b38163..0000000000000000000000000000000000000000 --- a/testing/lin/claset.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, M, N - COMPLEX ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLASET initializes a 2-D array A to BETA on the diagonal and -* ALPHA on the offdiagonals. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies the part of the matrix A to be set. -* = 'U': Upper triangular part is set. The lower triangle -* is unchanged. -* = 'L': Lower triangular part is set. The upper triangle -* is unchanged. -* Otherwise: All of the matrix A is set. -* -* M (input) INTEGER -* On entry, M specifies the number of rows of A. -* -* N (input) INTEGER -* On entry, N specifies the number of columns of A. -* -* ALPHA (input) COMPLEX -* All the offdiagonal array elements are set to ALPHA. -* -* BETA (input) COMPLEX -* All the diagonal array elements are set to BETA. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the m by n matrix A. -* On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j; -* A(i,i) = BETA , 1 <= i <= min(m,n) -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, J -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC MIN -* .. -* .. Executable Statements .. -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Set the diagonal to BETA and the strictly upper triangular -* part of the array to ALPHA. -* - DO 20 J = 2, N - DO 10 I = 1, MIN( J-1, M ) - A( I, J ) = ALPHA - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( N, M ) - A( I, I ) = BETA - 30 CONTINUE -* - ELSE IF( LSAME( UPLO, 'L' ) ) THEN -* -* Set the diagonal to BETA and the strictly lower triangular -* part of the array to ALPHA. -* - DO 50 J = 1, MIN( M, N ) - DO 40 I = J + 1, M - A( I, J ) = ALPHA - 40 CONTINUE - 50 CONTINUE - DO 60 I = 1, MIN( N, M ) - A( I, I ) = BETA - 60 CONTINUE -* - ELSE -* -* Set the array to BETA on the diagonal and ALPHA on the -* offdiagonal. -* - DO 80 J = 1, N - DO 70 I = 1, M - A( I, J ) = ALPHA - 70 CONTINUE - 80 CONTINUE - DO 90 I = 1, MIN( M, N ) - A( I, I ) = BETA - 90 CONTINUE - END IF -* - RETURN -* -* End of CLASET -* - END diff --git a/testing/lin/clatb4.f b/testing/lin/clatb4.f deleted file mode 100644 index 46a3dbacc6f19aa769ceb280c8be4ffc213b14db..0000000000000000000000000000000000000000 --- a/testing/lin/clatb4.f +++ /dev/null @@ -1,476 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER IMAT, KL, KU, M, MODE, N - REAL ANORM, CNDNUM -* .. -* -* Purpose -* ======= -* -* CLATB4 sets parameters for the matrix generator based on the type of -* matrix to be generated. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name. -* -* IMAT (input) INTEGER -* An integer key describing which matrix to generate for this -* path. -* -* M (input) INTEGER -* The number of rows in the matrix to be generated. -* -* N (input) INTEGER -* The number of columns in the matrix to be generated. -* -* TYPE (output) CHARACTER*1 -* The type of the matrix to be generated: -* = 'S': symmetric matrix -* = 'P': symmetric positive (semi)definite matrix -* = 'N': nonsymmetric matrix -* -* KL (output) INTEGER -* The lower band width of the matrix to be generated. -* -* KU (output) INTEGER -* The upper band width of the matrix to be generated. -* -* ANORM (output) REAL -* The desired norm of the matrix to be generated. The diagonal -* matrix of singular values or eigenvalues is scaled by this -* value. -* -* MODE (output) INTEGER -* A key indicating how to choose the vector of eigenvalues. -* -* CNDNUM (output) REAL -* The desired condition number. -* -* DIST (output) CHARACTER*1 -* The type of distribution to be used by the random number -* generator. -* -* ===================================================================== -* -* .. Parameters .. - REAL SHRINK, TENTH - PARAMETER ( SHRINK = 0.25E0, TENTH = 0.1E+0 ) - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - REAL TWO - PARAMETER ( TWO = 2.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL FIRST - CHARACTER*2 C2 - INTEGER MAT - REAL BADC1, BADC2, EPS, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAMEN - REAL SLAMCH - EXTERNAL LSAMEN, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT -* .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. -* .. Save statement .. - SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST -* .. -* .. Data statements .. - DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* Set some constants for use in the subroutine. -* - IF( FIRST ) THEN - FIRST = .FALSE. - EPS = SLAMCH( 'Precision' ) - BADC2 = TENTH / EPS - BADC1 = SQRT( BADC2 ) - SMALL = SLAMCH( 'Safe minimum' ) - LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) - SMALL = SHRINK*( SMALL / EPS ) - LARGE = ONE / SMALL - END IF -* - C2 = PATH( 2: 3 ) -* -* Set some parameters we don't plan to change. -* - DIST = 'S' - MODE = 3 -* -* xQR, xLQ, xQL, xRQ: Set parameters to generate a general -* M x N matrix. -* - IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR. - $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* xGE: Set parameters to generate a general M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.10 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.11 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* xGB: Set parameters to generate a general banded matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = TENTH*BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN -* -* xGT: Set parameters to generate a general tridiagonal matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) .OR. - $ LSAMEN( 2, C2, 'HE' ) .OR. LSAMEN( 2, C2, 'HP' ) .OR. - $ LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a -* symmetric or Hermitian matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = C2( 1: 1 ) -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = MAX( N-1, 0 ) - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.7 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.8 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.9 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* xPB: Set parameters to generate a symmetric band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'P' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN -* -* xPT: Set parameters to generate a symmetric positive definite -* tridiagonal matrix. -* - TYPE = 'P' - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN -* -* xTR, xTP: Set parameters to generate a triangular matrix -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - MAT = ABS( IMAT ) - IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.LT.0 ) THEN - KL = MAX( N-1, 0 ) - KU = 0 - ELSE - KL = 0 - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN - CNDNUM = BADC1 - ELSE IF( MAT.EQ.4 .OR. MAT.EQ.10 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( MAT.EQ.5 ) THEN - ANORM = SMALL - ELSE IF( MAT.EQ.6 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* xTB: Set parameters to generate a triangular band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.2 .OR. IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.3 .OR. IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.4 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.5 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF - END IF - IF( N.LE.1 ) - $ CNDNUM = ONE -* - RETURN -* -* End of CLATB4 -* - END diff --git a/testing/lin/clatm1.f b/testing/lin/clatm1.f deleted file mode 100644 index 9550e3d65f0e1c71a5488ba2b207d3849a9ce434..0000000000000000000000000000000000000000 --- a/testing/lin/clatm1.f +++ /dev/null @@ -1,274 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST, INFO, IRSIGN, MODE, N - REAL COND -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX D( * ) -* .. -* -* Purpose -* ======= -* -* CLATM1 computes the entries of D(1..N) as specified by -* MODE, COND and IRSIGN. IDIST and ISEED determine the generation -* of random numbers. CLATM1 is called by CLATMR to generate -* random test matrices for LAPACK programs. -* -* Arguments -* ========= -* -* MODE - INTEGER -* On entry describes how D is to be computed: -* MODE = 0 means do not change D. -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* Not modified. -* -* COND - REAL -* On entry, used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* IRSIGN - INTEGER -* On entry, if MODE neither -6, 0 nor 6, determines sign of -* entries of D -* 0 => leave entries of D unchanged -* 1 => multiply each entry of D by random complex number -* uniformly distributed with absolute value 1 -* -* IDIST - CHARACTER*1 -* On entry, IDIST specifies the type of distribution to be -* used to generate a random matrix . -* 1 => real and imaginary parts each UNIFORM( 0, 1 ) -* 2 => real and imaginary parts each UNIFORM( -1, 1 ) -* 3 => real and imaginary parts each NORMAL( 0, 1 ) -* 4 => complex number uniform in DISK( 0, 1 ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The random number generator uses a -* linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to CLATM1 -* to continue the same random number sequence. -* Changed on exit. -* -* D - COMPLEX array, dimension ( MIN( M , N ) ) -* Array to be computed according to MODE, COND and IRSIGN. -* May be changed on exit if MODE is nonzero. -* -* N - INTEGER -* Number of entries of D. Not modified. -* -* INFO - INTEGER -* 0 => normal termination -* -1 => if MODE not in range -6 to 6 -* -2 => if MODE neither -6, 0 nor 6, and -* IRSIGN neither 0 nor 1 -* -3 => if MODE neither -6, 0 nor 6 and COND less than 1 -* -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 4 -* -7 => if N negative -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - INTEGER I - REAL ALPHA, TEMP - COMPLEX CTEMP -* .. -* .. External Functions .. - REAL SLARAN - COMPLEX CLARND - EXTERNAL SLARAN, CLARND -* .. -* .. External Subroutines .. - EXTERNAL CLARNV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, EXP, LOG, REAL -* .. -* .. Executable Statements .. -* -* Decode and Test the input parameters. Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Set INFO if an error -* - IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN - INFO = -1 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN - INFO = -2 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ COND.LT.ONE ) THEN - INFO = -3 - ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND. - $ ( IDIST.LT.1 .OR. IDIST.GT.4 ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -7 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLATM1', -INFO ) - RETURN - END IF -* -* Compute D according to COND and MODE -* - IF( MODE.NE.0 ) THEN - GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE ) -* -* One large D value: -* - 10 CONTINUE - DO 20 I = 1, N - D( I ) = ONE / COND - 20 CONTINUE - D( 1 ) = ONE - GO TO 120 -* -* One small D value: -* - 30 CONTINUE - DO 40 I = 1, N - D( I ) = ONE - 40 CONTINUE - D( N ) = ONE / COND - GO TO 120 -* -* Exponentially distributed D values: -* - 50 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - ALPHA = COND**( -ONE / REAL( N-1 ) ) - DO 60 I = 2, N - D( I ) = ALPHA**( I-1 ) - 60 CONTINUE - END IF - GO TO 120 -* -* Arithmetically distributed D values: -* - 70 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - TEMP = ONE / COND - ALPHA = ( ONE-TEMP ) / REAL( N-1 ) - DO 80 I = 2, N - D( I ) = REAL( N-I )*ALPHA + TEMP - 80 CONTINUE - END IF - GO TO 120 -* -* Randomly distributed D values on ( 1/COND , 1): -* - 90 CONTINUE - ALPHA = LOG( ONE / COND ) - DO 100 I = 1, N - D( I ) = EXP( ALPHA*SLARAN( ISEED ) ) - 100 CONTINUE - GO TO 120 -* -* Randomly distributed D values from IDIST -* - 110 CONTINUE - CALL CLARNV( IDIST, ISEED, N, D ) -* - 120 CONTINUE -* -* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign -* random signs to D -* - IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ IRSIGN.EQ.1 ) THEN - DO 130 I = 1, N - CTEMP = CLARND( 3, ISEED ) - D( I ) = D( I )*( CTEMP / ABS( CTEMP ) ) - 130 CONTINUE - END IF -* -* Reverse if MODE < 0 -* - IF( MODE.LT.0 ) THEN - DO 140 I = 1, N / 2 - CTEMP = D( I ) - D( I ) = D( N+1-I ) - D( N+1-I ) = CTEMP - 140 CONTINUE - END IF -* - END IF -* - RETURN -* -* End of CLATM1 -* - END diff --git a/testing/lin/clatms.f b/testing/lin/clatms.f deleted file mode 100644 index 3b533da10ff505a74f659b425c27ba1e7789fb98..0000000000000000000000000000000000000000 --- a/testing/lin/clatms.f +++ /dev/null @@ -1,1203 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, - $ KL, KU, PACK, A, LDA, WORK, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, PACK, SYM - INTEGER INFO, KL, KU, LDA, M, MODE, N - REAL COND, DMAX -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL D( * ) - COMPLEX A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* CLATMS generates random matrices with specified singular values -* (or hermitian with specified eigenvalues) -* for testing LAPACK programs. -* -* CLATMS operates by applying the following sequence of -* operations: -* -* Set the diagonal to D, where D may be input or -* computed according to MODE, COND, DMAX, and SYM -* as described below. -* -* Generate a matrix with the appropriate band structure, by one -* of two methods: -* -* Method A: -* Generate a dense M x N matrix by multiplying D on the left -* and the right by random unitary matrices, then: -* -* Reduce the bandwidth according to KL and KU, using -* Householder transformations. -* -* Method B: -* Convert the bandwidth-0 (i.e., diagonal) matrix to a -* bandwidth-1 matrix using Givens rotations, "chasing" -* out-of-band elements back, much as in QR; then convert -* the bandwidth-1 to a bandwidth-2 matrix, etc. Note -* that for reasonably small bandwidths (relative to M and -* N) this requires less storage, as a dense matrix is not -* generated. Also, for hermitian or symmetric matrices, -* only one triangle is generated. -* -* Method A is chosen if the bandwidth is a large fraction of the -* order of the matrix, and LDA is at least M (so a dense -* matrix can be stored.) Method B is chosen if the bandwidth -* is small (< 1/2 N for hermitian or symmetric, < .3 N+M for -* non-symmetric), or LDA is less than M and not less than the -* bandwidth. -* -* Pack the matrix if desired. Options specified by PACK are: -* no packing -* zero out upper half (if hermitian) -* zero out lower half (if hermitian) -* store the upper half columnwise (if hermitian or upper -* triangular) -* store the lower half columnwise (if hermitian or lower -* triangular) -* store the lower triangle in banded format (if hermitian or -* lower triangular) -* store the upper triangle in banded format (if hermitian or -* upper triangular) -* store the entire matrix in banded format -* If Method B is chosen, and band format is specified, then the -* matrix will be generated in the band format, so no repacking -* will be necessary. -* -* Arguments -* ========= -* -* M - INTEGER -* The number of rows of A. Not modified. -* -* N - INTEGER -* The number of columns of A. N must equal M if the matrix -* is symmetric or hermitian (i.e., if SYM is not 'N') -* Not modified. -* -* DIST - CHARACTER*1 -* On entry, DIST specifies the type of distribution to be used -* to generate the random eigen-/singular values. -* 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) -* 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) -* 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. They should lie between 0 and 4095 inclusive, -* and ISEED(4) should be odd. The random number generator -* uses a linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to CLATMS -* to continue the same random number sequence. -* Changed on exit. -* -* SYM - CHARACTER*1 -* If SYM='H', the generated matrix is hermitian, with -* eigenvalues specified by D, COND, MODE, and DMAX; they -* may be positive, negative, or zero. -* If SYM='P', the generated matrix is hermitian, with -* eigenvalues (= singular values) specified by D, COND, -* MODE, and DMAX; they will not be negative. -* If SYM='N', the generated matrix is nonsymmetric, with -* singular values specified by D, COND, MODE, and DMAX; -* they will not be negative. -* If SYM='S', the generated matrix is (complex) symmetric, -* with singular values specified by D, COND, MODE, and -* DMAX; they will not be negative. -* Not modified. -* -* D - REAL array, dimension ( MIN( M, N ) ) -* This array is used to specify the singular values or -* eigenvalues of A (see SYM, above.) If MODE=0, then D is -* assumed to contain the singular/eigenvalues, otherwise -* they will be computed according to MODE, COND, and DMAX, -* and placed in D. -* Modified if MODE is nonzero. -* -* MODE - INTEGER -* On entry this describes how the singular/eigenvalues are to -* be specified: -* MODE = 0 means use D as input -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* If SYM='H', and MODE is neither 0, 6, nor -6, then -* the elements of D will also be multiplied by a random -* sign (i.e., +1 or -1.) -* Not modified. -* -* COND - REAL -* On entry, this is used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* DMAX - REAL -* If MODE is neither -6, 0 nor 6, the contents of D, as -* computed according to MODE and COND, will be scaled by -* DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or -* singular value (which is to say the norm) will be abs(DMAX). -* Note that DMAX need not be positive: if DMAX is negative -* (or zero), D will be scaled by a negative number (or zero). -* Not modified. -* -* KL - INTEGER -* This specifies the lower bandwidth of the matrix. For -* example, KL=0 implies upper triangular, KL=1 implies upper -* Hessenberg, and KL being at least M-1 means that the matrix -* has full lower bandwidth. KL must equal KU if the matrix -* is symmetric or hermitian. -* Not modified. -* -* KU - INTEGER -* This specifies the upper bandwidth of the matrix. For -* example, KU=0 implies lower triangular, KU=1 implies lower -* Hessenberg, and KU being at least N-1 means that the matrix -* has full upper bandwidth. KL must equal KU if the matrix -* is symmetric or hermitian. -* Not modified. -* -* PACK - CHARACTER*1 -* This specifies packing of matrix as follows: -* 'N' => no packing -* 'U' => zero out all subdiagonal entries (if symmetric -* or hermitian) -* 'L' => zero out all superdiagonal entries (if symmetric -* or hermitian) -* 'C' => store the upper triangle columnwise (only if the -* matrix is symmetric, hermitian, or upper triangular) -* 'R' => store the lower triangle columnwise (only if the -* matrix is symmetric, hermitian, or lower triangular) -* 'B' => store the lower triangle in band storage scheme -* (only if the matrix is symmetric, hermitian, or -* lower triangular) -* 'Q' => store the upper triangle in band storage scheme -* (only if the matrix is symmetric, hermitian, or -* upper triangular) -* 'Z' => store the entire matrix in band storage scheme -* (pivoting can be provided for by using this -* option to store A in the trailing rows of -* the allocated storage) -* -* Using these options, the various LAPACK packed and banded -* storage schemes can be obtained: -* GB - use 'Z' -* PB, SB, HB, or TB - use 'B' or 'Q' -* PP, SP, HB, or TP - use 'C' or 'R' -* -* If two calls to CLATMS differ only in the PACK parameter, -* they will generate mathematically equivalent matrices. -* Not modified. -* -* A - COMPLEX array, dimension ( LDA, N ) -* On exit A is the desired test matrix. A is first generated -* in full (unpacked) form, and then packed, if so specified -* by PACK. Thus, the first M elements of the first N -* columns will always be modified. If PACK specifies a -* packed or banded storage scheme, all LDA elements of the -* first N columns will be modified; the elements of the -* array which do not correspond to elements of the generated -* matrix are set to zero. -* Modified. -* -* LDA - INTEGER -* LDA specifies the first dimension of A as declared in the -* calling program. If PACK='N', 'U', 'L', 'C', or 'R', then -* LDA must be at least M. If PACK='B' or 'Q', then LDA must -* be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). -* If PACK='Z', LDA must be large enough to hold the packed -* array: MIN( KU, N-1) + MIN( KL, M-1) + 1. -* Not modified. -* -* WORK - COMPLEX array, dimension ( 3*MAX( N, M ) ) -* Workspace. -* Modified. -* -* INFO - INTEGER -* Error code. On exit, INFO will be set to one of the -* following values: -* 0 => normal return -* -1 => M negative or unequal to N and SYM='S', 'H', or 'P' -* -2 => N negative -* -3 => DIST illegal string -* -5 => SYM illegal string -* -7 => MODE not in range -6 to 6 -* -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 -* -10 => KL negative -* -11 => KU negative, or SYM is not 'N' and KU is not equal to -* KL -* -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; -* or PACK='C' or 'Q' and SYM='N' and KL is not zero; -* or PACK='R' or 'B' and SYM='N' and KU is not zero; -* or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not -* N. -* -14 => LDA is less than M, or PACK='Z' and LDA is less than -* MIN(KU,N-1) + MIN(KL,M-1) + 1. -* 1 => Error return from SLATM1 -* 2 => Cannot scale to DMAX (max. sing. value is 0) -* 3 => Error return from CLAGGE, CLAGHE or CLAGSY -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - COMPLEX CZERO - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) - REAL TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) -* .. -* .. Local Scalars .. - LOGICAL CSYM, GIVENS, ILEXTR, ILTEMP, TOPDWN - INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA, - $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2, - $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH, - $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC, - $ UUB - REAL ALPHA, ANGLE, REALC, TEMP - COMPLEX C, CT, CTEMP, DUMMY, EXTRA, S, ST -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLARND - COMPLEX CLARND - EXTERNAL LSAME, SLARND, CLARND -* .. -* .. External Subroutines .. - EXTERNAL CLAGGE, CLAGHE, CLAGSY, CLAROT, CLARTG, CLASET, - $ SLATM1, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, CMPLX, CONJG, COS, MAX, MIN, MOD, REAL, - $ SIN -* .. -* .. Executable Statements .. -* -* 1) Decode and Test the input parameters. -* Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN -* -* Decode DIST -* - IF( LSAME( DIST, 'U' ) ) THEN - IDIST = 1 - ELSE IF( LSAME( DIST, 'S' ) ) THEN - IDIST = 2 - ELSE IF( LSAME( DIST, 'N' ) ) THEN - IDIST = 3 - ELSE - IDIST = -1 - END IF -* -* Decode SYM -* - IF( LSAME( SYM, 'N' ) ) THEN - ISYM = 1 - IRSIGN = 0 - CSYM = .FALSE. - ELSE IF( LSAME( SYM, 'P' ) ) THEN - ISYM = 2 - IRSIGN = 0 - CSYM = .FALSE. - ELSE IF( LSAME( SYM, 'S' ) ) THEN - ISYM = 2 - IRSIGN = 0 - CSYM = .TRUE. - ELSE IF( LSAME( SYM, 'H' ) ) THEN - ISYM = 2 - IRSIGN = 1 - CSYM = .FALSE. - ELSE - ISYM = -1 - END IF -* -* Decode PACK -* - ISYMPK = 0 - IF( LSAME( PACK, 'N' ) ) THEN - IPACK = 0 - ELSE IF( LSAME( PACK, 'U' ) ) THEN - IPACK = 1 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'L' ) ) THEN - IPACK = 2 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'C' ) ) THEN - IPACK = 3 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'R' ) ) THEN - IPACK = 4 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'B' ) ) THEN - IPACK = 5 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'Q' ) ) THEN - IPACK = 6 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'Z' ) ) THEN - IPACK = 7 - ELSE - IPACK = -1 - END IF -* -* Set certain internal parameters -* - MNMIN = MIN( M, N ) - LLB = MIN( KL, M-1 ) - UUB = MIN( KU, N-1 ) - MR = MIN( M, N+LLB ) - NC = MIN( N, M+UUB ) -* - IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN - MINLDA = UUB + 1 - ELSE IF( IPACK.EQ.7 ) THEN - MINLDA = LLB + UUB + 1 - ELSE - MINLDA = M - END IF -* -* Use Givens rotation method if bandwidth small enough, -* or if LDA is too small to store the matrix unpacked. -* - GIVENS = .FALSE. - IF( ISYM.EQ.1 ) THEN - IF( REAL( LLB+UUB ).LT.0.3*REAL( MAX( 1, MR+NC ) ) ) - $ GIVENS = .TRUE. - ELSE - IF( 2*LLB.LT.M ) - $ GIVENS = .TRUE. - END IF - IF( LDA.LT.M .AND. LDA.GE.MINLDA ) - $ GIVENS = .TRUE. -* -* Set INFO if an error -* - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( IDIST.EQ.-1 ) THEN - INFO = -3 - ELSE IF( ISYM.EQ.-1 ) THEN - INFO = -5 - ELSE IF( ABS( MODE ).GT.6 ) THEN - INFO = -7 - ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) - $ THEN - INFO = -8 - ELSE IF( KL.LT.0 ) THEN - INFO = -10 - ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN - INFO = -11 - ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR. - $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR. - $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR. - $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN - INFO = -12 - ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN - INFO = -14 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLATMS', -INFO ) - RETURN - END IF -* -* Initialize random number generator -* - DO 10 I = 1, 4 - ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) - 10 CONTINUE -* - IF( MOD( ISEED( 4 ), 2 ).NE.1 ) - $ ISEED( 4 ) = ISEED( 4 ) + 1 -* -* 2) Set up D if indicated. -* -* Compute D according to COND and MODE -* - CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) - IF( IINFO.NE.0 ) THEN - INFO = 1 - RETURN - END IF -* -* Choose Top-Down if D is (apparently) increasing, -* Bottom-Up if D is (apparently) decreasing. -* - IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN - TOPDWN = .TRUE. - ELSE - TOPDWN = .FALSE. - END IF -* - IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN -* -* Scale by DMAX -* - TEMP = ABS( D( 1 ) ) - DO 20 I = 2, MNMIN - TEMP = MAX( TEMP, ABS( D( I ) ) ) - 20 CONTINUE -* - IF( TEMP.GT.ZERO ) THEN - ALPHA = DMAX / TEMP - ELSE - INFO = 2 - RETURN - END IF -* - CALL SSCAL( MNMIN, ALPHA, D, 1 ) -* - END IF -* - CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) -* -* 3) Generate Banded Matrix using Givens rotations. -* Also the special case of UUB=LLB=0 -* -* Compute Addressing constants to cover all -* storage formats. Whether GE, HE, SY, GB, HB, or SB, -* upper or lower triangle or both, -* the (i,j)-th element is in -* A( i - ISKEW*j + IOFFST, j ) -* - IF( IPACK.GT.4 ) THEN - ILDA = LDA - 1 - ISKEW = 1 - IF( IPACK.GT.5 ) THEN - IOFFST = UUB + 1 - ELSE - IOFFST = 1 - END IF - ELSE - ILDA = LDA - ISKEW = 0 - IOFFST = 0 - END IF -* -* IPACKG is the format that the matrix is generated in. If this is -* different from IPACK, then the matrix must be repacked at the -* end. It also signals how to compute the norm, for scaling. -* - IPACKG = 0 -* -* Diagonal Matrix -- We are done, unless it -* is to be stored HP/SP/PP/TP (PACK='R' or 'C') -* - IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN - DO 30 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFST, J ) = CMPLX( D( J ) ) - 30 CONTINUE -* - IF( IPACK.LE.2 .OR. IPACK.GE.5 ) - $ IPACKG = IPACK -* - ELSE IF( GIVENS ) THEN -* -* Check whether to use Givens rotations, -* Householder transformations, or nothing. -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - IF( IPACK.GT.4 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF -* - DO 40 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFST, J ) = CMPLX( D( J ) ) - 40 CONTINUE -* - IF( TOPDWN ) THEN - JKL = 0 - DO 70 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* Last row actually rotated is M -* Last column actually rotated is MIN( M+JKU, N ) -* - DO 60 JR = 1, MIN( M+JKU, N ) + JKL - 1 - EXTRA = CZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - ICOL = MAX( 1, JR-JKL ) - IF( JR.LT.M ) THEN - IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL CLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, - $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IR = JR - IC = ICOL - DO 50 JCH = JR - JKL, 1, -JKL - JKU - IF( IR.LT.M ) THEN - CALL CLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = CONJG( REALC*DUMMY ) - S = CONJG( -S*DUMMY ) - END IF - IROW = MAX( 1, JCH-JKU ) - IL = IR + 2 - IROW - CTEMP = CZERO - ILTEMP = JCH.GT.JKU - CALL CLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, - $ A( IROW-ISKEW*IC+IOFFST, IC ), - $ ILDA, CTEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL CLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), CTEMP, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = CONJG( REALC*DUMMY ) - S = CONJG( -S*DUMMY ) -* - ICOL = MAX( 1, JCH-JKU-JKL ) - IL = IC + 2 - ICOL - EXTRA = CZERO - CALL CLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., - $ IL, C, S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ CTEMP ) - IC = ICOL - IR = IROW - END IF - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* - JKU = UUB - DO 100 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* - DO 90 JC = 1, MIN( N+JKL, M ) + JKU - 1 - EXTRA = CZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - IROW = MAX( 1, JC-JKU ) - IF( JC.LT.N ) THEN - IL = MIN( M, JC+JKL ) + 1 - IROW - CALL CLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, - $ S, A( IROW-ISKEW*JC+IOFFST, JC ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IC = JC - IR = IROW - DO 80 JCH = JC - JKU, 1, -JKL - JKU - IF( IC.LT.N ) THEN - CALL CLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = CONJG( REALC*DUMMY ) - S = CONJG( -S*DUMMY ) - END IF - ICOL = MAX( 1, JCH-JKL ) - IL = IC + 2 - ICOL - CTEMP = CZERO - ILTEMP = JCH.GT.JKL - CALL CLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, - $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, CTEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL CLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST, - $ ICOL+1 ), CTEMP, REALC, S, - $ DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = CONJG( REALC*DUMMY ) - S = CONJG( -S*DUMMY ) - IROW = MAX( 1, JCH-JKL-JKU ) - IL = IR + 2 - IROW - EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., - $ IL, C, S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ CTEMP ) - IC = ICOL - IR = IROW - END IF - 80 CONTINUE - 90 CONTINUE - 100 CONTINUE -* - ELSE -* -* Bottom-Up -- Start at the bottom right. -* - JKL = 0 - DO 130 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* First row actually rotated is M -* First column actually rotated is MIN( M+JKU, N ) -* - IENDCH = MIN( M, N+JKL ) - 1 - DO 120 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1 - EXTRA = CZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - IROW = MAX( 1, JC-JKU+1 ) - IF( JC.GT.0 ) THEN - IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL CLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, - $ C, S, A( IROW-ISKEW*JC+IOFFST, - $ JC ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IC = JC - DO 110 JCH = JC + JKL, IENDCH, JKL + JKU - ILEXTR = IC.GT.0 - IF( ILEXTR ) THEN - CALL CLARTG( A( JCH-ISKEW*IC+IOFFST, IC ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - END IF - IC = MAX( 1, IC ) - ICOL = MIN( N-1, JCH+JKU ) - ILTEMP = JCH + JKU.LT.N - CTEMP = CZERO - CALL CLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, - $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), - $ ILDA, EXTRA, CTEMP ) - IF( ILTEMP ) THEN - CALL CLARTG( A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), CTEMP, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = CZERO - CALL CLAROT( .FALSE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, CTEMP, EXTRA ) - IC = ICOL - END IF - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* - JKU = UUB - DO 160 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* -* First row actually rotated is MIN( N+JKL, M ) -* First column actually rotated is N -* - IENDCH = MIN( N, M+JKU ) - 1 - DO 150 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1 - EXTRA = CZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - ICOL = MAX( 1, JR-JKL+1 ) - IF( JR.GT.0 ) THEN - IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL CLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, - $ C, S, A( JR-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IR = JR - DO 140 JCH = JR + JKU, IENDCH, JKL + JKU - ILEXTR = IR.GT.0 - IF( ILEXTR ) THEN - CALL CLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - END IF - IR = MAX( 1, IR ) - IROW = MIN( M-1, JCH+JKL ) - ILTEMP = JCH + JKL.LT.M - CTEMP = CZERO - CALL CLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, - $ C, S, A( IR-ISKEW*JCH+IOFFST, - $ JCH ), ILDA, EXTRA, CTEMP ) - IF( ILTEMP ) THEN - CALL CLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ CTEMP, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = CZERO - CALL CLAROT( .TRUE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ ILDA, CTEMP, EXTRA ) - IR = IROW - END IF - 140 CONTINUE - 150 CONTINUE - 160 CONTINUE -* - END IF -* - ELSE -* -* Symmetric -- A = U D U' -* Hermitian -- A = U D U* -* - IPACKG = IPACK - IOFFG = IOFFST -* - IF( TOPDWN ) THEN -* -* Top-Down -- Generate Upper triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 6 - IOFFG = UUB + 1 - ELSE - IPACKG = 1 - END IF -* - DO 170 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFG, J ) = CMPLX( D( J ) ) - 170 CONTINUE -* - DO 200 K = 1, UUB - DO 190 JC = 1, N - 1 - IROW = MAX( 1, JC-K ) - IL = MIN( JC+1, K+2 ) - EXTRA = CZERO - CTEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 ) - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - IF( CSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = CONJG( CTEMP ) - CT = CONJG( C ) - ST = CONJG( S ) - END IF - CALL CLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S, - $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA, - $ EXTRA, CTEMP ) - CALL CLAROT( .TRUE., .TRUE., .FALSE., - $ MIN( K, N-JC )+1, CT, ST, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ CTEMP, DUMMY ) -* -* Chase EXTRA back up the matrix -* - ICOL = JC - DO 180 JCH = JC - K, 1, -K - CALL CLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, - $ ICOL+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = CONJG( REALC*DUMMY ) - S = CONJG( -S*DUMMY ) - CTEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - IF( CSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = CONJG( CTEMP ) - CT = CONJG( C ) - ST = CONJG( S ) - END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, CTEMP, EXTRA ) - IROW = MAX( 1, JCH-K ) - IL = MIN( JCH+1, K+2 ) - EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, - $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), - $ ILDA, EXTRA, CTEMP ) - ICOL = JCH - 180 CONTINUE - 190 CONTINUE - 200 CONTINUE -* -* If we need lower triangle, copy from upper. Note that -* the order of copying is chosen to work for 'q' -> 'b' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN - DO 230 JC = 1, N - IROW = IOFFST - ISKEW*JC - IF( CSYM ) THEN - DO 210 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 210 CONTINUE - ELSE - DO 220 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = CONJG( A( JC-ISKEW*JR+ - $ IOFFG, JR ) ) - 220 CONTINUE - END IF - 230 CONTINUE - IF( IPACK.EQ.5 ) THEN - DO 250 JC = N - UUB + 1, N - DO 240 JR = N + 2 - JC, UUB + 1 - A( JR, JC ) = CZERO - 240 CONTINUE - 250 CONTINUE - END IF - IF( IPACKG.EQ.6 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - ELSE -* -* Bottom-Up -- Generate Lower triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 5 - IF( IPACK.EQ.6 ) - $ IOFFG = 1 - ELSE - IPACKG = 2 - END IF -* - DO 260 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFG, J ) = CMPLX( D( J ) ) - 260 CONTINUE -* - DO 290 K = 1, UUB - DO 280 JC = N - 1, 1, -1 - IL = MIN( N+1-JC, K+2 ) - EXTRA = CZERO - CTEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC ) - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE )*CLARND( 5, ISEED ) - S = SIN( ANGLE )*CLARND( 5, ISEED ) - IF( CSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = CONJG( CTEMP ) - CT = CONJG( C ) - ST = CONJG( S ) - END IF - CALL CLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ CTEMP, EXTRA ) - ICOL = MAX( 1, JC-K+1 ) - CALL CLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, - $ CT, ST, A( JC-ISKEW*ICOL+IOFFG, - $ ICOL ), ILDA, DUMMY, CTEMP ) -* -* Chase EXTRA back down the matrix -* - ICOL = JC - DO 270 JCH = JC + K, N - 1, K - CALL CLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = CLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - CTEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - IF( CSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = CONJG( CTEMP ) - CT = CONJG( C ) - ST = CONJG( S ) - END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, EXTRA, CTEMP ) - IL = MIN( N+1-JCH, K+2 ) - EXTRA = CZERO - CALL CLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, - $ CT, ST, A( ( 1-ISKEW )*JCH+IOFFG, - $ JCH ), ILDA, CTEMP, EXTRA ) - ICOL = JCH - 270 CONTINUE - 280 CONTINUE - 290 CONTINUE -* -* If we need upper triangle, copy from lower. Note that -* the order of copying is chosen to work for 'b' -> 'q' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN - DO 320 JC = N, 1, -1 - IROW = IOFFST - ISKEW*JC - IF( CSYM ) THEN - DO 300 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 300 CONTINUE - ELSE - DO 310 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = CONJG( A( JC-ISKEW*JR+ - $ IOFFG, JR ) ) - 310 CONTINUE - END IF - 320 CONTINUE - IF( IPACK.EQ.6 ) THEN - DO 340 JC = 1, UUB - DO 330 JR = 1, UUB + 1 - JC - A( JR, JC ) = CZERO - 330 CONTINUE - 340 CONTINUE - END IF - IF( IPACKG.EQ.5 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - END IF -* -* Ensure that the diagonal is real if Hermitian -* - IF( .NOT.CSYM ) THEN - DO 350 JC = 1, N - IROW = IOFFST + ( 1-ISKEW )*JC - A( IROW, JC ) = CMPLX( REAL( A( IROW, JC ) ) ) - 350 CONTINUE - END IF -* - END IF -* - ELSE -* -* 4) Generate Banded Matrix by first -* Rotating by random Unitary matrices, -* then reducing the bandwidth using Householder -* transformations. -* -* Note: we should get here only if LDA .ge. N -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - CALL CLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK, - $ IINFO ) - ELSE -* -* Symmetric -- A = U D U' or -* Hermitian -- A = U D U* -* - IF( CSYM ) THEN - CALL CLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) - ELSE - CALL CLAGHE( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) - END IF - END IF -* - IF( IINFO.NE.0 ) THEN - INFO = 3 - RETURN - END IF - END IF -* -* 5) Pack the matrix -* - IF( IPACK.NE.IPACKG ) THEN - IF( IPACK.EQ.1 ) THEN -* -* 'U' -- Upper triangular, not packed -* - DO 370 J = 1, M - DO 360 I = J + 1, M - A( I, J ) = CZERO - 360 CONTINUE - 370 CONTINUE -* - ELSE IF( IPACK.EQ.2 ) THEN -* -* 'L' -- Lower triangular, not packed -* - DO 390 J = 2, M - DO 380 I = 1, J - 1 - A( I, J ) = CZERO - 380 CONTINUE - 390 CONTINUE -* - ELSE IF( IPACK.EQ.3 ) THEN -* -* 'C' -- Upper triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 410 J = 1, M - DO 400 I = 1, J - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 400 CONTINUE - 410 CONTINUE -* - ELSE IF( IPACK.EQ.4 ) THEN -* -* 'R' -- Lower triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 430 J = 1, M - DO 420 I = J, M - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 420 CONTINUE - 430 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* 'B' -- The lower triangle is packed as a band matrix. -* 'Q' -- The upper triangle is packed as a band matrix. -* 'Z' -- The whole matrix is packed as a band matrix. -* - IF( IPACK.EQ.5 ) - $ UUB = 0 - IF( IPACK.EQ.6 ) - $ LLB = 0 -* - DO 450 J = 1, UUB - DO 440 I = MIN( J+LLB, M ), 1, -1 - A( I-J+UUB+1, J ) = A( I, J ) - 440 CONTINUE - 450 CONTINUE -* - DO 470 J = UUB + 2, N - DO 460 I = J - UUB, MIN( J+LLB, M ) - A( I-J+UUB+1, J ) = A( I, J ) - 460 CONTINUE - 470 CONTINUE - END IF -* -* If packed, zero out extraneous elements. -* -* Symmetric/Triangular Packed -- -* zero out everything after A(IROW,ICOL) -* - IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN - DO 490 JC = ICOL, M - DO 480 JR = IROW + 1, LDA - A( JR, JC ) = CZERO - 480 CONTINUE - IROW = 0 - 490 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* Packed Band -- -* 1st row is now in A( UUB+2-j, j), zero above it -* m-th row is now in A( M+UUB-j,j), zero below it -* last non-zero diagonal is now in A( UUB+LLB+1,j ), -* zero below it, too. -* - IR1 = UUB + LLB + 2 - IR2 = UUB + M + 2 - DO 520 JC = 1, N - DO 500 JR = 1, UUB + 1 - JC - A( JR, JC ) = CZERO - 500 CONTINUE - DO 510 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA - A( JR, JC ) = CZERO - 510 CONTINUE - 520 CONTINUE - END IF - END IF -* - RETURN -* -* End of CLATMS -* - END diff --git a/testing/lin/clatrs.f b/testing/lin/clatrs.f deleted file mode 100644 index 38cc5a2a22794de7b5929036b0aaf24be1d165da..0000000000000000000000000000000000000000 --- a/testing/lin/clatrs.f +++ /dev/null @@ -1,916 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, - $ CNORM, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, NORMIN, TRANS, UPLO - INTEGER INFO, LDA, N - REAL SCALE -* .. -* .. Array Arguments .. - REAL CNORM( * ) - COMPLEX A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* CLATRS solves one of the triangular systems -* -* A * x = s*b, A^T * x = s*b, or A^H * x = s*b, -* -* with scaling to prevent overflow. Here A is an upper or lower -* triangular matrix, A^T denotes the transpose of A, A^H denotes the -* conjugate transpose of A, x and b are n-element vectors, and s is a -* scaling factor, usually less than or equal to 1, chosen so that the -* components of x will be less than the overflow threshold. If the -* unscaled problem will not cause overflow, the Level 2 BLAS routine -* CTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j), -* then s is set to 0 and a non-trivial solution to A*x = 0 is returned. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to A. -* = 'N': Solve A * x = s*b (No transpose) -* = 'T': Solve A^T * x = s*b (Transpose) -* = 'C': Solve A^H * x = s*b (Conjugate transpose) -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* NORMIN (input) CHARACTER*1 -* Specifies whether CNORM has been set or not. -* = 'Y': CNORM contains the column norms on entry -* = 'N': CNORM is not set on entry. On exit, the norms will -* be computed and stored in CNORM. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The triangular matrix A. If UPLO = 'U', the leading n by n -* upper triangular part of the array A contains the upper -* triangular matrix, and the strictly lower triangular part of -* A is not referenced. If UPLO = 'L', the leading n by n lower -* triangular part of the array A contains the lower triangular -* matrix, and the strictly upper triangular part of A is not -* referenced. If DIAG = 'U', the diagonal elements of A are -* also not referenced and are assumed to be 1. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max (1,N). -* -* X (input/output) COMPLEX array, dimension (N) -* On entry, the right hand side b of the triangular system. -* On exit, X is overwritten by the solution vector x. -* -* SCALE (output) REAL -* The scaling factor s for the triangular system -* A * x = s*b, A^T * x = s*b, or A^H * x = s*b. -* If SCALE = 0, the matrix A is singular or badly scaled, and -* the vector x is an exact or approximate solution to A*x = 0. -* -* CNORM (input or output) REAL array, dimension (N) -* -* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) -* contains the norm of the off-diagonal part of the j-th column -* of A. If TRANS = 'N', CNORM(j) must be greater than or equal -* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) -* must be greater than or equal to the 1-norm. -* -* If NORMIN = 'N', CNORM is an output argument and CNORM(j) -* returns the 1-norm of the offdiagonal part of the j-th column -* of A. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* Further Details -* ======= ======= -* -* A rough bound on x is computed; if that is less than overflow, CTRSV -* is called, otherwise, specific code is used which checks for possible -* overflow or divide-by-zero at every operation. -* -* A columnwise scheme is used for solving A*x = b. The basic algorithm -* if A is lower triangular is -* -* x[1:n] := b[1:n] -* for j = 1, ..., n -* x(j) := x(j) / A(j,j) -* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] -* end -* -* Define bounds on the components of x after j iterations of the loop: -* M(j) = bound on x[1:j] -* G(j) = bound on x[j+1:n] -* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. -* -* Then for iteration j+1 we have -* M(j+1) <= G(j) / | A(j+1,j+1) | -* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | -* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) -* -* where CNORM(j+1) is greater than or equal to the infinity-norm of -* column j+1 of A, not counting the diagonal. Hence -* -* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) -* 1<=i<=j -* and -* -* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) -* 1<=i< j -* -* Since |x(j)| <= M(j), we use the Level 2 BLAS routine CTRSV if the -* reciprocal of the largest M(j), j=1,..,n, is larger than -* max(underflow, 1/overflow). -* -* The bound on x(j) is also used to determine when a step in the -* columnwise method can be performed without fear of overflow. If -* the computed bound is greater than a large constant, x is scaled to -* prevent overflow, but if the bound overflows, x is set to 0, x(j) to -* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. -* -* Similarly, a row-wise scheme is used to solve A^T *x = b or -* A^H *x = b. The basic algorithm for A upper triangular is -* -* for j = 1, ..., n -* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) -* end -* -* We simultaneously compute two bounds -* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j -* M(j) = bound on x(i), 1<=i<=j -* -* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we -* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. -* Then the bound on x(j) is -* -* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | -* -* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) -* 1<=i<=j -* -* and we can safely call CTRSV if 1/M(n) and 1/G(n) are both greater -* than max(underflow, 1/overflow). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, HALF, ONE, TWO - PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0, - $ TWO = 2.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOTRAN, NOUNIT, UPPER - INTEGER I, IMAX, J, JFIRST, JINC, JLAST - REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, - $ XBND, XJ, XMAX - COMPLEX CSUMJ, TJJS, USCAL, ZDUM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ICAMAX, ISAMAX - REAL SCASUM, SLAMCH - COMPLEX CDOTC, CDOTU, CLADIV - EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, CDOTC, - $ CDOTU, CLADIV -* .. -* .. External Subroutines .. - EXTERNAL CAXPY, CSSCAL, CTRSV, SLABAD, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL -* .. -* .. Statement Functions .. - REAL CABS1, CABS2 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) - CABS2( ZDUM ) = ABS( REAL( ZDUM ) / 2. ) + - $ ABS( AIMAG( ZDUM ) / 2. ) -* .. -* .. Executable Statements .. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOTRAN = LSAME( TRANS, 'N' ) - NOUNIT = LSAME( DIAG, 'N' ) -* -* Test the input parameters. -* - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -3 - ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT. - $ LSAME( NORMIN, 'N' ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -5 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -7 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLATRS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine machine dependent parameters to control overflow. -* - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / SLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - SCALE = ONE -* - IF( LSAME( NORMIN, 'N' ) ) THEN -* -* Compute the 1-norm of each column, not including the diagonal. -* - IF( UPPER ) THEN -* -* A is upper triangular. -* - DO 10 J = 1, N - CNORM( J ) = SCASUM( J-1, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* A is lower triangular. -* - DO 20 J = 1, N - 1 - CNORM( J ) = SCASUM( N-J, A( J+1, J ), 1 ) - 20 CONTINUE - CNORM( N ) = ZERO - END IF - END IF -* -* Scale the column norms by TSCAL if the maximum element in CNORM is -* greater than BIGNUM/2. -* - IMAX = ISAMAX( N, CNORM, 1 ) - TMAX = CNORM( IMAX ) - IF( TMAX.LE.BIGNUM*HALF ) THEN - TSCAL = ONE - ELSE - TSCAL = HALF / ( SMLNUM*TMAX ) - CALL SSCAL( N, TSCAL, CNORM, 1 ) - END IF -* -* Compute a bound on the computed solution vector to see if the -* Level 2 BLAS routine CTRSV can be used. -* - XMAX = ZERO - DO 30 J = 1, N - XMAX = MAX( XMAX, CABS2( X( J ) ) ) - 30 CONTINUE - XBND = XMAX -* - IF( NOTRAN ) THEN -* -* Compute the growth in A * x = b. -* - IF( UPPER ) THEN - JFIRST = N - JLAST = 1 - JINC = -1 - ELSE - JFIRST = 1 - JLAST = N - JINC = 1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 60 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, G(0) = max{x(i), i=1,...,n}. -* - GROW = HALF / MAX( XBND, SMLNUM ) - XBND = GROW - DO 40 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 60 -* - TJJS = A( J, J ) - TJJ = CABS1( TJJS ) -* - IF( TJJ.GE.SMLNUM ) THEN -* -* M(j) = G(j-1) / abs(A(j,j)) -* - XBND = MIN( XBND, MIN( ONE, TJJ )*GROW ) - ELSE -* -* M(j) could overflow, set XBND to 0. -* - XBND = ZERO - END IF -* - IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN -* -* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) -* - GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) ) - ELSE -* -* G(j) could overflow, set GROW to 0. -* - GROW = ZERO - END IF - 40 CONTINUE - GROW = XBND - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) ) - DO 50 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 60 -* -* G(j) = G(j-1)*( 1 + CNORM(j) ) -* - GROW = GROW*( ONE / ( ONE+CNORM( J ) ) ) - 50 CONTINUE - END IF - 60 CONTINUE -* - ELSE -* -* Compute the growth in A^T * x = b or A^H * x = b. -* - IF( UPPER ) THEN - JFIRST = 1 - JLAST = N - JINC = 1 - ELSE - JFIRST = N - JLAST = 1 - JINC = -1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 90 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, M(0) = max{x(i), i=1,...,n}. -* - GROW = HALF / MAX( XBND, SMLNUM ) - XBND = GROW - DO 70 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 90 -* -* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) -* - XJ = ONE + CNORM( J ) - GROW = MIN( GROW, XBND / XJ ) -* - TJJS = A( J, J ) - TJJ = CABS1( TJJS ) -* - IF( TJJ.GE.SMLNUM ) THEN -* -* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) -* - IF( XJ.GT.TJJ ) - $ XBND = XBND*( TJJ / XJ ) - ELSE -* -* M(j) could overflow, set XBND to 0. -* - XBND = ZERO - END IF - 70 CONTINUE - GROW = MIN( GROW, XBND ) - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) ) - DO 80 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 90 -* -* G(j) = ( 1 + CNORM(j) )*G(j-1) -* - XJ = ONE + CNORM( J ) - GROW = GROW / XJ - 80 CONTINUE - END IF - 90 CONTINUE - END IF -* - IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN -* -* Use the Level 2 BLAS solve if the reciprocal of the bound on -* elements of X is not too small. -* - CALL CTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 ) - ELSE -* -* Use a Level 1 BLAS solve, scaling intermediate results. -* - IF( XMAX.GT.BIGNUM*HALF ) THEN -* -* Scale X so that its components are less than or equal to -* BIGNUM in absolute value. -* - SCALE = ( BIGNUM*HALF ) / XMAX - CALL CSSCAL( N, SCALE, X, 1 ) - XMAX = BIGNUM - ELSE - XMAX = XMAX*TWO - END IF -* - IF( NOTRAN ) THEN -* -* Solve A * x = b -* - DO 110 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) / A(j,j), scaling x if necessary. -* - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 105 - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by 1/b(j). -* - REC = ONE / XJ - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = CLADIV( X( J ), TJJS ) - XJ = CABS1( X( J ) ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM -* to avoid overflow when dividing by A(j,j). -* - REC = ( TJJ*BIGNUM ) / XJ - IF( CNORM( J ).GT.ONE ) THEN -* -* Scale by 1/CNORM(j) to avoid overflow when -* multiplying x(j) times column j. -* - REC = REC / CNORM( J ) - END IF - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = CLADIV( X( J ), TJJS ) - XJ = CABS1( X( J ) ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A*x = 0. -* - DO 100 I = 1, N - X( I ) = ZERO - 100 CONTINUE - X( J ) = ONE - XJ = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 105 CONTINUE -* -* Scale x if necessary to avoid overflow when adding a -* multiple of column j of A. -* - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -* -* Scale x by 1/(2*abs(x(j))). -* - REC = REC*HALF - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - END IF - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -* -* Scale x by 1/2. -* - CALL CSSCAL( N, HALF, X, 1 ) - SCALE = SCALE*HALF - END IF -* - IF( UPPER ) THEN - IF( J.GT.1 ) THEN -* -* Compute the update -* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) -* - CALL CAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X, - $ 1 ) - I = ICAMAX( J-1, X, 1 ) - XMAX = CABS1( X( I ) ) - END IF - ELSE - IF( J.LT.N ) THEN -* -* Compute the update -* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) -* - CALL CAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1, - $ X( J+1 ), 1 ) - I = J + ICAMAX( N-J, X( J+1 ), 1 ) - XMAX = CABS1( X( I ) ) - END IF - END IF - 110 CONTINUE -* - ELSE IF( LSAME( TRANS, 'T' ) ) THEN -* -* Solve A^T * x = b -* - DO 150 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = CABS1( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = CLADIV( USCAL, TJJS ) - END IF - IF( REC.LT.ONE ) THEN - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - CSUMJ = ZERO - IF( USCAL.EQ.CMPLX( ONE ) ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call CDOTU to perform the dot product. -* - IF( UPPER ) THEN - CSUMJ = CDOTU( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - CSUMJ = CDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 120 I = 1, J - 1 - CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I ) - 120 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 130 I = J + 1, N - CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I ) - 130 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.CMPLX( TSCAL ) ) THEN -* -* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - CSUMJ - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 145 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = CLADIV( X( J ), TJJS ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = CLADIV( X( J ), TJJS ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0 and compute a solution to A^T *x = 0. -* - DO 140 I = 1, N - X( I ) = ZERO - 140 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 145 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = CLADIV( X( J ), TJJS ) - CSUMJ - END IF - XMAX = MAX( XMAX, CABS1( X( J ) ) ) - 150 CONTINUE -* - ELSE -* -* Solve A^H * x = b -* - DO 190 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = CABS1( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = CONJG( A( J, J ) )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = CLADIV( USCAL, TJJS ) - END IF - IF( REC.LT.ONE ) THEN - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - CSUMJ = ZERO - IF( USCAL.EQ.CMPLX( ONE ) ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call CDOTC to perform the dot product. -* - IF( UPPER ) THEN - CSUMJ = CDOTC( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - CSUMJ = CDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 160 I = 1, J - 1 - CSUMJ = CSUMJ + ( CONJG( A( I, J ) )*USCAL )* - $ X( I ) - 160 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 170 I = J + 1, N - CSUMJ = CSUMJ + ( CONJG( A( I, J ) )*USCAL )* - $ X( I ) - 170 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.CMPLX( TSCAL ) ) THEN -* -* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - CSUMJ - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = CONJG( A( J, J ) )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 185 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = CLADIV( X( J ), TJJS ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL CSSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = CLADIV( X( J ), TJJS ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0 and compute a solution to A^H *x = 0. -* - DO 180 I = 1, N - X( I ) = ZERO - 180 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 185 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = CLADIV( X( J ), TJJS ) - CSUMJ - END IF - XMAX = MAX( XMAX, CABS1( X( J ) ) ) - 190 CONTINUE - END IF - SCALE = SCALE / TSCAL - END IF -* -* Scale the column norms by 1/TSCAL for return. -* - IF( TSCAL.NE.ONE ) THEN - CALL SSCAL( N, ONE / TSCAL, CNORM, 1 ) - END IF -* - RETURN -* -* End of CLATRS -* - END diff --git a/testing/lin/clauu2.f b/testing/lin/clauu2.f deleted file mode 100644 index a6539b1af7b71165a6ac31a333318c4d27527491..0000000000000000000000000000000000000000 --- a/testing/lin/clauu2.f +++ /dev/null @@ -1,181 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLAUU2 computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the unblocked form of the algorithm, calling Level 2 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I - REAL AII -* .. -* .. External Functions .. - LOGICAL LSAME - COMPLEX CDOTC - EXTERNAL LSAME, CDOTC -* .. -* .. External Subroutines .. - EXTERNAL CGEMV, CLACGV, CSSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLAUU2', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I, I+1 ), LDA, - $ A( I, I+1 ), LDA ) ) - CALL CLACGV( N-I, A( I, I+1 ), LDA ) - CALL CGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), - $ LDA, A( I, I+1 ), LDA, CMPLX( AII ), - $ A( 1, I ), 1 ) - CALL CLACGV( N-I, A( I, I+1 ), LDA ) - ELSE - CALL CSSCAL( I, AII, A( 1, I ), 1 ) - END IF - 10 CONTINUE -* - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I+1, I ), 1, - $ A( I+1, I ), 1 ) ) - CALL CLACGV( I-1, A( I, 1 ), LDA ) - CALL CGEMV( 'Conjugate transpose', N-I, I-1, ONE, - $ A( I+1, 1 ), LDA, A( I+1, I ), 1, - $ CMPLX( AII ), A( I, 1 ), LDA ) - CALL CLACGV( I-1, A( I, 1 ), LDA ) - ELSE - CALL CSSCAL( I, AII, A( I, 1 ), LDA ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of CLAUU2 -* - END diff --git a/testing/lin/clauum.f b/testing/lin/clauum.f deleted file mode 100644 index c02779080273beb2ba2460d60e62e97ac6b80064..0000000000000000000000000000000000000000 --- a/testing/lin/clauum.f +++ /dev/null @@ -1,198 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLAUUM( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CLAUUM computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the blocked form of the algorithm, calling Level 3 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - COMPLEX CONE - PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IB, NB -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CHERK, CLAUU2, CTRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CLAUUM', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'CLAUUM', UPLO, N, -1, -1, -1 ) -* - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL CLAUU2( UPLO, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose', - $ 'Non-unit', I-1, IB, CONE, A( I, I ), LDA, - $ A( 1, I ), LDA ) - CALL CLAUU2( 'Upper', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL CGEMM( 'No transpose', 'Conjugate transpose', - $ I-1, IB, N-I-IB+1, CONE, A( 1, I+IB ), - $ LDA, A( I, I+IB ), LDA, CONE, A( 1, I ), - $ LDA ) - CALL CHERK( 'Upper', 'No transpose', IB, N-I-IB+1, - $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ), - $ LDA ) - END IF - 10 CONTINUE - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL CTRMM( 'Left', 'Lower', 'Conjugate transpose', - $ 'Non-unit', IB, I-1, CONE, A( I, I ), LDA, - $ A( I, 1 ), LDA ) - CALL CLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL CGEMM( 'Conjugate transpose', 'No transpose', IB, - $ I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA, - $ A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA ) - CALL CHERK( 'Lower', 'Conjugate transpose', IB, - $ N-I-IB+1, ONE, A( I+IB, I ), LDA, ONE, - $ A( I, I ), LDA ) - END IF - 20 CONTINUE - END IF - END IF -* - RETURN -* -* End of CLAUUM -* - END diff --git a/testing/lin/clqt01.f b/testing/lin/clqt01.f deleted file mode 100644 index 28673d9c8dbe5c3abe2f18da32b62e2c5ee5841d..0000000000000000000000000000000000000000 --- a/testing/lin/clqt01.f +++ /dev/null @@ -1,194 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLQT01( M, N, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CLQT01 tests CGELQF, which computes the LQ factorization of an m-by-n -* matrix A, and partially tests CUNGLQ which forms the n-by-n -* orthogonal matrix Q. -* -* CLQT01 compares L with A*Q', and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) COMPLEX array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by CGELQF. -* See CGELQF for further details. -* -* Q (output) COMPLEX array, dimension (LDA,N) -* The n-by-n orthogonal matrix Q. -* -* L (workspace) COMPLEX array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. -* LDA >= max(M,N). -* -* TAU (output) COMPLEX array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by CGELQF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (max(M,N)) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL CLANGE, CLANSY, SLAMCH - EXTERNAL CLANGE, CLANSY, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGELQF, CGEMM, CHERK, CLACPY, CLASET, CUNGLQ -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, MIN, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'CGELQF' - CALL CHAMELEON_CGELQF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL CLASET( 'Full', M, N, CMPLX( ZERO ), CMPLX( ONE ), Q, LDA ) -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'CUNGLQ' - CALL CHAMELEON_CUNGLQ( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L -* - CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ZERO ), L, LDA ) - CALL CLACPY( 'Lower', M, N, AF, LDA, L, LDA ) -* -* Compute L - A*Q' -* - CALL CGEMM( 'No transpose', 'Conjugate transpose', M, M, N, - $ CMPLX( -ONE ), A, LDA, Q, LDA, CMPLX( ONE ), L, LDA ) -* -* Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) . -* - ANORM = CLANGE( '1', M, N, A, LDA, RWORK ) - RESID = CLANGE( '1', M, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), L, LDA ) - CALL CHERK( 'Upper', 'No transpose', M, N, ONE, Q, LDA, -ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = CLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of CLQT01 -* - END diff --git a/testing/lin/clqt02.f b/testing/lin/clqt02.f deleted file mode 100644 index 472c4ee20fd7b596a61811aa57bfccd08b9799b4..0000000000000000000000000000000000000000 --- a/testing/lin/clqt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLQT02( M, N, K, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CLQT02 tests CUNGLQ, which generates an m-by-n matrix Q with -* orthonornmal rows that is defined as the product of k elementary -* reflectors. -* -* Given the LQ factorization of an m-by-n matrix A, CLQT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and -* checks that the rows of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* N >= M >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. M >= K >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by CLQT01. -* -* AF (input) COMPLEX array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by CGELQF. -* See CGELQF for further details. -* -* Q (workspace) COMPLEX array, dimension (LDA,N) -* -* L (workspace) COMPLEX array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. LDA >= N. -* -* TAU (input) COMPLEX array, dimension (M) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL CLANGE, CLANSY, SLAMCH - EXTERNAL CLANGE, CLANSY, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CHERK, CLACPY, CLASET, CUNGLQ -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - CALL CLASET( 'Full', M, N, CMPLX( ZERO ), CMPLX( ONE ), Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'CUNGLQ' - CALL CHAMELEON_CUNGLQ( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L(1:k,1:m) -* - CALL CLASET( 'Full', K, M, CMPLX( ZERO ), CMPLX( ZERO ), L, LDA ) - CALL CLACPY( 'Lower', K, M, AF, LDA, L, LDA ) -* -* Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' -* - CALL CGEMM( 'No transpose', 'Conjugate transpose', K, M, N, - $ CMPLX( -ONE ), A, LDA, Q, LDA, CMPLX( ONE ), L, LDA ) -* -* Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . -* - ANORM = CLANGE( '1', K, N, A, LDA, RWORK ) - RESID = CLANGE( '1', K, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), L, LDA ) - CALL CHERK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = CLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of CLQT02 -* - END diff --git a/testing/lin/clqt03.f b/testing/lin/clqt03.f deleted file mode 100644 index 377028f3fa5ef399efd87838fd88c987693e0703..0000000000000000000000000000000000000000 --- a/testing/lin/clqt03.f +++ /dev/null @@ -1,241 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CLQT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CLQT03 tests CUNMLQ, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* CLQT03 compares the results of a call to CUNMLQ with the results of -* forming Q explicitly by a call to CUNGLQ and then performing matrix -* multiplication by a call to CGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows or columns of the matrix C; C is n-by-m if -* Q is applied from the left, or m-by-n if Q is applied from -* the right. M >= 0. -* -* N (input) INTEGER -* The order of the orthogonal matrix Q. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. N >= K >= 0. -* -* AF (input) COMPLEX array, dimension (LDA,N) -* Details of the LQ factorization of an m-by-n matrix, as -* returned by CGELQF. See CGELQF for further details. -* -* C (workspace) COMPLEX array, dimension (LDA,N) -* -* CC (workspace) COMPLEX array, dimension (LDA,N) -* -* Q (workspace) COMPLEX array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) COMPLEX array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an n-by-n orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( N * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( N * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( N * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( N * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - REAL CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLARNV, CLASET, CUNGLQ, CUNMLQ -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL CLASET( 'Full', N, N, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL CLASET( 'Full', N, N, CMPLX( ZERO ), CMPLX( ONE ), - $ Q, LDA ) - ENDIF -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'CUNGLQ' - CALL CHAMELEON_CUNGLQ( N, N, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = N - NC = M - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = M - NC = N - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL CLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = CLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.ZERO ) - $ CNORM = ONE -* -* DO 20 ITRANS = 1, 2 - DO 20 ITRANS = 2, 2 -* ONLY CONJTRANS SUPPORTED !!!! - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - END IF -* -* Copy C -* - CALL CLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'CUNMLQ' - CALL CHAMELEON_CUNMLQ( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL CLASET( 'Full', N, N, CMPLX( ZERO ), - $ CMPLX( ONE ), Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL CGEMM( TRANS, 'No transpose', MC, NC, MC, - $ CMPLX( -ONE ), Q, LDA, C, LDA, CMPLX( ONE ), - $ CC, LDA ) - ELSE - CALL CGEMM( 'No transpose', TRANS, MC, NC, NC, - $ CMPLX( -ONE ), C, LDA, Q, LDA, CMPLX( ONE ), - $ CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = CLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( REAL( MAX( 1, N ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of CLQT03 -* - END diff --git a/testing/lin/cpocon.f b/testing/lin/cpocon.f deleted file mode 100644 index 3fd5f26c4e1b3132922ea6131ccec39ad3da0255..0000000000000000000000000000000000000000 --- a/testing/lin/cpocon.f +++ /dev/null @@ -1,221 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call CLACN2 in place of CLACON, 10 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N - REAL ANORM, RCOND -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* CPOCON estimates the reciprocal of the condition number (in the -* 1-norm) of a complex Hermitian positive definite matrix using the -* Cholesky factorization A = U^H*U or A = L*L^H computed by CPOTRF. -* -* An estimate is obtained for norm(inv(A)), and the reciprocal of the -* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^H*U or A = L*L^H, as computed by CPOTRF. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* ANORM (input) REAL -* The 1-norm (or infinity-norm) of the Hermitian matrix A. -* -* RCOND (output) REAL -* The reciprocal of the condition number of the matrix A, -* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an -* estimate of the 1-norm of inv(A) computed in this routine. -* -* WORK (workspace) COMPLEX array, dimension (2*N) -* -* RWORK (workspace) REAL array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - CHARACTER NORMIN - INTEGER IX, KASE - REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM - COMPLEX ZDUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ICAMAX - REAL SLAMCH - EXTERNAL LSAME, ICAMAX, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CLACN2, CLATRS, CSRSCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, REAL -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - ELSE IF( ANORM.LT.ZERO ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CPOCON', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - RCOND = ZERO - IF( N.EQ.0 ) THEN - RCOND = ONE - RETURN - ELSE IF( ANORM.EQ.ZERO ) THEN - RETURN - END IF -* - SMLNUM = SLAMCH( 'Safe minimum' ) -* -* Estimate the 1-norm of inv(A). -* - KASE = 0 - NORMIN = 'N' - 10 CONTINUE - CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( UPPER ) THEN -* -* Multiply by inv(U'). -* - CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', - $ NORMIN, N, A, LDA, WORK, SCALEL, RWORK, INFO ) - NORMIN = 'Y' -* -* Multiply by inv(U). -* - CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEU, RWORK, INFO ) - ELSE -* -* Multiply by inv(L). -* - CALL CLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEL, RWORK, INFO ) - NORMIN = 'Y' -* -* Multiply by inv(L'). -* - CALL CLATRS( 'Lower', 'Conjugate transpose', 'Non-unit', - $ NORMIN, N, A, LDA, WORK, SCALEU, RWORK, INFO ) - END IF -* -* Multiply by 1/SCALE if doing so will not cause overflow. -* - SCALE = SCALEL*SCALEU - IF( SCALE.NE.ONE ) THEN - IX = ICAMAX( N, WORK, 1 ) - IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) - $ GO TO 20 - CALL CSRSCL( N, SCALE, WORK, 1 ) - END IF - GO TO 10 - END IF -* -* Compute the estimate of the reciprocal condition number. -* - IF( AINVNM.NE.ZERO ) - $ RCOND = ( ONE / AINVNM ) / ANORM -* - 20 CONTINUE - RETURN -* -* End of CPOCON -* - END diff --git a/testing/lin/cpoequ.f b/testing/lin/cpoequ.f deleted file mode 100644 index 6d1858f5764f69f1748886c646abc5a52d28d46f..0000000000000000000000000000000000000000 --- a/testing/lin/cpoequ.f +++ /dev/null @@ -1,174 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOEQU( N, A, LDA, S, SCOND, AMAX, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, N - REAL AMAX, SCOND -* .. -* .. Array Arguments .. - REAL S( * ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CPOEQU computes row and column scalings intended to equilibrate a -* Hermitian positive definite matrix A and reduce its condition number -* (with respect to the two-norm). S contains the scale factors, -* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with -* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This -* choice of S puts the condition number of B within a factor N of the -* smallest possible condition number over all possible diagonal -* scalings. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The N-by-N Hermitian positive definite matrix whose scaling -* factors are to be computed. Only the diagonal elements of A -* are referenced. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* S (output) REAL array, dimension (N) -* If INFO = 0, S contains the scale factors for A. -* -* SCOND (output) REAL -* If INFO = 0, S contains the ratio of the smallest S(i) to -* the largest S(i). If SCOND >= 0.1 and AMAX is neither too -* large nor too small, it is not worth scaling by S. -* -* AMAX (output) REAL -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the i-th diagonal element is nonpositive. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I - REAL SMIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, REAL, SQRT -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -3 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CPOEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) THEN - SCOND = ONE - AMAX = ZERO - RETURN - END IF -* -* Find the minimum and maximum diagonal elements. -* - S( 1 ) = REAL( A( 1, 1 ) ) - SMIN = S( 1 ) - AMAX = S( 1 ) - DO 10 I = 2, N - S( I ) = REAL( A( I, I ) ) - SMIN = MIN( SMIN, S( I ) ) - AMAX = MAX( AMAX, S( I ) ) - 10 CONTINUE -* - IF( SMIN.LE.ZERO ) THEN -* -* Find the first non-positive diagonal element and return. -* - DO 20 I = 1, N - IF( S( I ).LE.ZERO ) THEN - INFO = I - RETURN - END IF - 20 CONTINUE - ELSE -* -* Set the scale factors to the reciprocals -* of the diagonal elements. -* - DO 30 I = 1, N - S( I ) = ONE / SQRT( S( I ) ) - 30 CONTINUE -* -* Compute SCOND = min(S(I)) / max(S(I)) -* - SCOND = SQRT( SMIN ) / SQRT( AMAX ) - END IF - RETURN -* -* End of CPOEQU -* - END diff --git a/testing/lin/cporfs.f b/testing/lin/cporfs.f deleted file mode 100644 index 616a71ce76ebe960952778409f3a3be0dd391ac9..0000000000000000000000000000000000000000 --- a/testing/lin/cporfs.f +++ /dev/null @@ -1,385 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, - $ LDX, FERR, BERR, WORK, RWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call CLACN2 in place of CLACON, 10 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* .. -* .. Array Arguments .. - REAL BERR( * ), FERR( * ), RWORK( * ) - COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CPORFS improves the computed solution to a system of linear -* equations when the coefficient matrix is Hermitian positive definite, -* and provides error bounds and backward error estimates for the -* solution. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input) COMPLEX array, dimension (LDAF,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^H*U or A = L*L^H, as computed by CPOTRF. -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* B (input) COMPLEX array, dimension (LDB,NRHS) -* The right hand side matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input/output) COMPLEX array, dimension (LDX,NRHS) -* On entry, the solution matrix X, as computed by CPOTRS. -* On exit, the improved solution matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* FERR (output) REAL array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) COMPLEX array, dimension (2*N) -* -* RWORK (workspace) REAL array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* Internal Parameters -* =================== -* -* ITMAX is the maximum number of steps of iterative refinement. -* -* ==================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) - REAL TWO - PARAMETER ( TWO = 2.0E+0 ) - REAL THREE - PARAMETER ( THREE = 3.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER COUNT, I, J, K, KASE, NZ, CHAMELEON_UPLO - REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK - COMPLEX ZDUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHEMV, CLACN2, CPOTRS, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, REAL -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH - EXTERNAL LSAME, SLAMCH -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -7 - ELSE IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -9 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CPORFS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN - DO 10 J = 1, NRHS - FERR( J ) = ZERO - BERR( J ) = ZERO - 10 CONTINUE - RETURN - END IF -* - IF ( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* -* NZ = maximum number of nonzero elements in each row of A, plus 1 -* - NZ = N + 1 - EPS = SLAMCH( 'Epsilon' ) - SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN - SAFE2 = SAFE1 / EPS -* -* Do for each right hand side -* - DO 140 J = 1, NRHS -* - COUNT = 1 - LSTRES = THREE - 20 CONTINUE -* -* Loop until stopping criterion is satisfied. -* -* Compute residual R = B - A * X -* - CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) -* -* Compute componentwise relative backward error from formula -* -* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) ) -* -* where abs(Z) is the componentwise absolute value of the matrix -* or vector Z. If the i-th component of the denominator is less -* than SAFE2, then SAFE1 is added to the i-th components of the -* numerator and denominator before dividing. -* - DO 30 I = 1, N - RWORK( I ) = CABS1( B( I, J ) ) - 30 CONTINUE -* -* Compute abs(A)*abs(X) + abs(B). -* - IF( UPPER ) THEN - DO 50 K = 1, N - S = ZERO - XK = CABS1( X( K, J ) ) - DO 40 I = 1, K - 1 - RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK - S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) ) - 40 CONTINUE - RWORK( K ) = RWORK( K ) + ABS( REAL( A( K, K ) ) )*XK + S - 50 CONTINUE - ELSE - DO 70 K = 1, N - S = ZERO - XK = CABS1( X( K, J ) ) - RWORK( K ) = RWORK( K ) + ABS( REAL( A( K, K ) ) )*XK - DO 60 I = K + 1, N - RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK - S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) ) - 60 CONTINUE - RWORK( K ) = RWORK( K ) + S - 70 CONTINUE - END IF - S = ZERO - DO 80 I = 1, N - IF( RWORK( I ).GT.SAFE2 ) THEN - S = MAX( S, CABS1( WORK( I ) ) / RWORK( I ) ) - ELSE - S = MAX( S, ( CABS1( WORK( I ) )+SAFE1 ) / - $ ( RWORK( I )+SAFE1 ) ) - END IF - 80 CONTINUE - BERR( J ) = S -* -* Test stopping criterion. Continue iterating if -* 1) The residual BERR(J) is larger than machine epsilon, and -* 2) BERR(J) decreased by at least a factor of 2 during the -* last iteration, and -* 3) At most ITMAX iterations tried. -* - IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND. - $ COUNT.LE.ITMAX ) THEN -* -* Update solution and try again. -* - CALL CHAMELEON_CPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK, N, INFO ) - CALL CAXPY( N, ONE, WORK, 1, X( 1, J ), 1 ) - LSTRES = BERR( J ) - COUNT = COUNT + 1 - GO TO 20 - END IF -* -* Bound error from formula -* -* norm(X - XTRUE) / norm(X) .le. FERR = -* norm( abs(inv(A))* -* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X) -* -* where -* norm(Z) is the magnitude of the largest component of Z -* inv(A) is the inverse of A -* abs(Z) is the componentwise absolute value of the matrix or -* vector Z -* NZ is the maximum number of nonzeros in any row of A, plus 1 -* EPS is machine epsilon -* -* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B)) -* is incremented by SAFE1 if the i-th component of -* abs(A)*abs(X) + abs(B) is less than SAFE2. -* -* Use CLACN2 to estimate the infinity-norm of the matrix -* inv(A) * diag(W), -* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) -* - DO 90 I = 1, N - IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) - ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 - END IF - 90 CONTINUE -* - KASE = 0 - 100 CONTINUE - CALL CLACN2( N, WORK( N+1 ), WORK, FERR( J ), KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( KASE.EQ.1 ) THEN -* -* Multiply by diag(W)*inv(A'). -* - CALL CHAMELEON_CPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - 4 WORK, N, INFO ) - DO 110 I = 1, N - WORK( I ) = RWORK( I )*WORK( I ) - 110 CONTINUE - ELSE IF( KASE.EQ.2 ) THEN -* -* Multiply by inv(A)*diag(W). -* - DO 120 I = 1, N - WORK( I ) = RWORK( I )*WORK( I ) - 120 CONTINUE - CALL CHAMELEON_CPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - END IF - GO TO 100 - END IF -* -* Normalize error. -* - LSTRES = ZERO - DO 130 I = 1, N - LSTRES = MAX( LSTRES, CABS1( X( I, J ) ) ) - 130 CONTINUE - IF( LSTRES.NE.ZERO ) - $ FERR( J ) = FERR( J ) / LSTRES -* - 140 CONTINUE -* - RETURN -* -* End of CPORFS -* - END diff --git a/testing/lin/cposvx.f b/testing/lin/cposvx.f deleted file mode 100644 index d502bd56fba3abde4055591da86c651259b85f31..0000000000000000000000000000000000000000 --- a/testing/lin/cposvx.f +++ /dev/null @@ -1,422 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, - $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, - $ RWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK driver routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - REAL RCOND -* .. -* .. Array Arguments .. - REAL BERR( * ), FERR( * ), RWORK( * ), S( * ) - COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CPOSVX uses the Cholesky factorization A = U^H*U or A = L*L^H to -* compute the solution to a complex system of linear equations -* A * X = B, -* where A is an N-by-N Hermitian positive definite matrix and X and B -* are N-by-NRHS matrices. -* -* Error bounds on the solution and a condition estimate are also -* provided. -* -* Description -* =========== -* -* The following steps are performed: -* -* 1. If FACT = 'E', real scaling factors are computed to equilibrate -* the system: -* diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B -* Whether or not the system will be equilibrated depends on the -* scaling of the matrix A, but if equilibration is used, A is -* overwritten by diag(S)*A*diag(S) and B by diag(S)*B. -* -* 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to -* factor the matrix A (after equilibration if FACT = 'E') as -* A = U^H* U, if UPLO = 'U', or -* A = L * L^H, if UPLO = 'L', -* where U is an upper triangular matrix and L is a lower triangular -* matrix. -* -* 3. If the leading i-by-i principal minor is not positive definite, -* then the routine returns with INFO = i. Otherwise, the factored -* form of A is used to estimate the condition number of the matrix -* A. If the reciprocal of the condition number is less than machine -* precision, INFO = N+1 is returned as a warning, but the routine -* still goes on to solve for X and compute error bounds as -* described below. -* -* 4. The system of equations is solved for X using the factored form -* of A. -* -* 5. Iterative refinement is applied to improve the computed solution -* matrix and calculate error bounds and backward error estimates -* for it. -* -* 6. If equilibration was used, the matrix X is premultiplied by -* diag(S) so that it solves the original system before -* equilibration. -* -* Arguments -* ========= -* -* FACT (input) CHARACTER*1 -* Specifies whether or not the factored form of the matrix A is -* supplied on entry, and if not, whether the matrix A should be -* equilibrated before it is factored. -* = 'F': On entry, AF contains the factored form of A. -* If EQUED = 'Y', the matrix A has been equilibrated -* with scaling factors given by S. A and AF will not -* be modified. -* = 'N': The matrix A will be copied to AF and factored. -* = 'E': The matrix A will be equilibrated if necessary, then -* copied to AF and factored. -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The number of linear equations, i.e., the order of the -* matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the Hermitian matrix A, except if FACT = 'F' and -* EQUED = 'Y', then A must contain the equilibrated matrix -* diag(S)*A*diag(S). 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. A is not modified if -* FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit. -* -* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by -* diag(S)*A*diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input or output) COMPLEX array, dimension (LDAF,N) -* If FACT = 'F', then AF is an input argument and on entry -* contains the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H, in the same storage -* format as A. If EQUED .ne. 'N', then AF is the factored form -* of the equilibrated matrix diag(S)*A*diag(S). -* -* If FACT = 'N', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H of the original -* matrix A. -* -* If FACT = 'E', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H of the equilibrated -* matrix A (see the description of A for the form of the -* equilibrated matrix). -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* EQUED (input or output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration (always true if FACT = 'N'). -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* EQUED is an input argument if FACT = 'F'; otherwise, it is an -* output argument. -* -* S (input or output) REAL array, dimension (N) -* The scale factors for A; not accessed if EQUED = 'N'. S is -* an input argument if FACT = 'F'; otherwise, S is an output -* argument. If FACT = 'F' and EQUED = 'Y', each element of S -* must be positive. -* -* B (input/output) COMPLEX array, dimension (LDB,NRHS) -* On entry, the N-by-NRHS righthand side matrix B. -* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y', -* B is overwritten by diag(S) * B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (output) COMPLEX array, dimension (LDX,NRHS) -* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to -* the original system of equations. Note that if EQUED = 'Y', -* A and B are modified on exit, and the solution to the -* equilibrated system is inv(diag(S))*X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* RCOND (output) REAL -* The estimate of the reciprocal condition number of the matrix -* A after equilibration (if done). If RCOND is less than the -* machine precision (in particular, if RCOND = 0), the matrix -* is singular to working precision. This condition is -* indicated by a return code of INFO > 0. -* -* FERR (output) REAL array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) COMPLEX array, dimension (2*N) -* -* RWORK (workspace) REAL array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= N: the leading minor of order i of A is -* not positive definite, so the factorization -* could not be completed, and the solution has not -* been computed. RCOND = 0 is returned. -* = N+1: U is nonsingular, but RCOND is less than machine -* precision, meaning that the matrix is singular -* to working precision. Nevertheless, the -* solution and error bounds are computed because -* there are a number of situations where the -* computed solution can be more accurate than the -* value of RCOND would suggest. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, RCEQU - INTEGER I, INFEQU, J - REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM - INTEGER CHAMELEON_UPLO -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANHE, SLAMCH - EXTERNAL LSAME, CLANHE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CLACPY, CLAQHE, CPOCON, CPOEQU, CPORFS, CPOTRF, - $ CPOTRS, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - RCEQU = .FALSE. - ELSE - RCEQU = LSAME( EQUED, 'Y' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) - $ THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -9 - ELSE - IF( RCEQU ) THEN - SMIN = BIGNUM - SMAX = ZERO - DO 10 J = 1, N - SMIN = MIN( SMIN, S( J ) ) - SMAX = MAX( SMAX, S( J ) ) - 10 CONTINUE - IF( SMIN.LE.ZERO ) THEN - INFO = -10 - ELSE IF( N.GT.0 ) THEN - SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM ) - ELSE - SCOND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -12 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -14 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CPOSVX', -INFO ) - RETURN - END IF -* - IF( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL CPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) - RCEQU = LSAME( EQUED, 'Y' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( RCEQU ) THEN - DO 30 J = 1, NRHS - DO 20 I = 1, N - B( I, J ) = S( I )*B( I, J ) - 20 CONTINUE - 30 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the Cholesky factorization A = U'*U or A = L*L'. -* - CALL CLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CHAMELEON_CPOTRF( CHAMELEON_UPLO, N, AF, LDAF, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 )THEN - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A. -* - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) -* -* Compute the reciprocal of the condition number of A. -* - CALL CPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL CLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CHAMELEON_CPOTRS( CHAMELEON_UPLO, N, NRHS, AF, LDAF, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, - $ FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( RCEQU ) THEN - DO 50 J = 1, NRHS - DO 40 I = 1, N - X( I, J ) = S( I )*X( I, J ) - 40 CONTINUE - 50 CONTINUE - DO 60 J = 1, NRHS - FERR( J ) = FERR( J ) / SCOND - 60 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RETURN -* -* End of CPOSVX -* - END diff --git a/testing/lin/cpot01.f b/testing/lin/cpot01.f deleted file mode 100644 index a1e8af05b71a407283a1e17e9a305c5539c43bfb..0000000000000000000000000000000000000000 --- a/testing/lin/cpot01.f +++ /dev/null @@ -1,213 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAFAC, N - REAL RESID -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), AFAC( LDAFAC, * ) -* .. -* -* Purpose -* ======= -* -* CPOT01 reconstructs a Hermitian positive definite matrix A from -* its L*L' or U'*U factorization and computes the residual -* norm( L*L' - A ) / ( N * norm(A) * EPS ) or -* norm( U'*U - A ) / ( N * norm(A) * EPS ), -* where EPS is the machine epsilon, L' is the conjugate transpose of L, -* and U' is the conjugate transpose of U. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AFAC (input/output) COMPLEX array, dimension (LDAFAC,N) -* On entry, the factor L or U from the L*L' or U'*U -* factorization of A. -* Overwritten with the reconstructed matrix, and then with the -* difference L*L' - A (or U'*U - A). -* -* LDAFAC (input) INTEGER -* The leading dimension of the array AFAC. LDAFAC >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RESID (output) REAL -* If UPLO = 'L', norm(L*L' - A) / ( N * norm(A) * EPS ) -* If UPLO = 'U', norm(U'*U - A) / ( N * norm(A) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J, K - REAL ANORM, EPS, TR - COMPLEX TC -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANHE, SLAMCH - COMPLEX CDOTC - EXTERNAL LSAME, CLANHE, SLAMCH, CDOTC -* .. -* .. External Subroutines .. - EXTERNAL CHER, CSCAL, CTRMV -* .. -* .. Intrinsic Functions .. - INTRINSIC AIMAG, REAL -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Check the imaginary parts of the diagonal elements and return with -* an error code if any are nonzero. -* - DO 10 J = 1, N - IF( AIMAG( AFAC( J, J ) ).NE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF - 10 CONTINUE -* -* Compute the product U'*U, overwriting U. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 K = N, 1, -1 -* -* Compute the (K,K) element of the result. -* - TR = CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) - AFAC( K, K ) = TR -* -* Compute the rest of column K. -* - CALL CTRMV( 'Upper', 'Conjugate', 'Non-unit', K-1, AFAC, - $ LDAFAC, AFAC( 1, K ), 1 ) -* - 20 CONTINUE -* -* Compute the product L*L', overwriting L. -* - ELSE - DO 30 K = N, 1, -1 -* -* Add a multiple of column K of the factor L to each of -* columns K+1 through N. -* - IF( K+1.LE.N ) - $ CALL CHER( 'Lower', N-K, ONE, AFAC( K+1, K ), 1, - $ AFAC( K+1, K+1 ), LDAFAC ) -* -* Scale column K by the diagonal element. -* - TC = AFAC( K, K ) - CALL CSCAL( N-K+1, TC, AFAC( K, K ), 1 ) -* - 30 CONTINUE - END IF -* -* Compute the difference L*L' - A (or U'*U - A). -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 50 J = 1, N - DO 40 I = 1, J - 1 - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 40 CONTINUE - AFAC( J, J ) = AFAC( J, J ) - REAL( A( J, J ) ) - 50 CONTINUE - ELSE - DO 70 J = 1, N - AFAC( J, J ) = AFAC( J, J ) - REAL( A( J, J ) ) - DO 60 I = J + 1, N - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 60 CONTINUE - 70 CONTINUE - END IF -* -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) -* - RESID = CLANHE( '1', UPLO, N, AFAC, LDAFAC, RWORK ) -* - RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS -* - RETURN -* -* End of CPOT01 -* - END diff --git a/testing/lin/cpot02.f b/testing/lin/cpot02.f deleted file mode 100644 index 2a8fa1772bc4673594ad2c7158f4bf8a087d899e..0000000000000000000000000000000000000000 --- a/testing/lin/cpot02.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, - $ RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CPOT02 computes the residual for the solution of a Hermitian system -* of linear equations A*x = b: -* -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* B (input/output) COMPLEX array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX CONE - PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J - REAL ANORM, BNORM, RHSNORM, EPS, XNORM -* .. -* .. External Functions .. - REAL CLANHE, SCASUM, SLAMCH, CLANGE - EXTERNAL CLANHE, SCASUM, SLAMCH, CLANGE -* .. -* .. External Subroutines .. - EXTERNAL CHEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) - RHSNORM = CLANGE( '1', N, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X -* - CALL CHEMM( 'Left', UPLO, N, NRHS, -CONE, A, LDA, X, LDX, CONE, B, - $ LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SCASUM( N, B( 1, J ), 1 ) - XNORM = SCASUM( N, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of CPOT02 -* - END diff --git a/testing/lin/cpot03.f b/testing/lin/cpot03.f deleted file mode 100644 index db064cf9ed1d9d9b8179a53c7f9e5458960d5cca..0000000000000000000000000000000000000000 --- a/testing/lin/cpot03.f +++ /dev/null @@ -1,188 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOT03( UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, - $ RWORK, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAINV, LDWORK, N - REAL RCOND, RESID -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), AINV( LDAINV, * ), - $ WORK( LDWORK, * ) -* .. -* -* Purpose -* ======= -* -* CPOT03 computes the residual for a Hermitian matrix times its -* inverse: -* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AINV (input/output) COMPLEX array, dimension (LDAINV,N) -* On entry, the inverse of the matrix A, stored as a Hermitian -* matrix in the same format as A. -* In this version, AINV is expanded into a full matrix and -* multiplied by A, so the opposing triangle of AINV will be -* changed; i.e., if the upper triangular part of AINV is -* stored, the lower triangular part will be used as work space. -* -* LDAINV (input) INTEGER -* The leading dimension of the array AINV. LDAINV >= max(1,N). -* -* WORK (workspace) COMPLEX array, dimension (LDWORK,N) -* -* LDWORK (input) INTEGER -* The leading dimension of the array WORK. LDWORK >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RCOND (output) REAL -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(AINV). -* -* RESID (output) REAL -* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), - $ CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL AINVNM, ANORM, EPS -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, CLANHE, SLAMCH - EXTERNAL LSAME, CLANGE, CLANHE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CHEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC CONJG, REAL -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RCOND = ONE - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) - AINVNM = CLANHE( '1', UPLO, N, AINV, LDAINV, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCOND = ZERO - RESID = ONE / EPS - RETURN - END IF - RCOND = ( ONE/ANORM ) / AINVNM -* -* Expand AINV into a full matrix and call CHEMM to multiply -* AINV on the left by A. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - AINV( J, I ) = CONJG( AINV( I, J ) ) - 10 CONTINUE - 20 CONTINUE - ELSE - DO 40 J = 1, N - DO 30 I = J + 1, N - AINV( J, I ) = CONJG( AINV( I, J ) ) - 30 CONTINUE - 40 CONTINUE - END IF - CALL CHEMM( 'Left', UPLO, N, N, -CONE, A, LDA, AINV, LDAINV, - $ CZERO, WORK, LDWORK ) -* -* Add the identity matrix to WORK . -* - DO 50 I = 1, N - WORK( I, I ) = WORK( I, I ) + CONE - 50 CONTINUE -* -* Compute norm(I - A*AINV) / (N * norm(A) * norm(AINV) * EPS) -* - RESID = CLANGE( '1', N, N, WORK, LDWORK, RWORK ) -* - RESID = ( ( RESID*RCOND )/EPS ) / REAL( N ) -* - RETURN -* -* End of CPOT03 -* - END diff --git a/testing/lin/cpot05.f b/testing/lin/cpot05.f deleted file mode 100644 index 90767cf4f0ae0c197a3891bb57b16559268ab31d..0000000000000000000000000000000000000000 --- a/testing/lin/cpot05.f +++ /dev/null @@ -1,252 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOT05( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, - $ LDXACT, FERR, BERR, RESLTS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, LDXACT, N, NRHS -* .. -* .. Array Arguments .. - REAL BERR( * ), FERR( * ), RESLTS( * ) - COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ), - $ XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* CPOT05 tests the error bounds from iterative refinement for the -* computed solution to a system of equations A*X = B, where A is a -* Hermitian n by n matrix. -* -* RESLTS(1) = test of the error bound -* = norm(X - XACT) / ( norm(X) * FERR ) -* -* A large value is returned if this ratio is not less than one. -* -* RESLTS(2) = residual from the iterative refinement routine -* = the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows of the matrices X, B, and XACT, and the -* order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X, B, and XACT. -* NRHS >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* B (input) COMPLEX array, dimension (LDB,NRHS) -* The right hand side vectors for the system of linear -* equations. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) COMPLEX array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* FERR (input) REAL array, dimension (NRHS) -* The estimated forward error bounds for each solution vector -* X. If XTRUE is the true solution, FERR bounds the magnitude -* of the largest entry in (X - XTRUE) divided by the magnitude -* of the largest entry in X. -* -* BERR (input) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector (i.e., the smallest relative change in any entry of A -* or B that makes X an exact solution). -* -* RESLTS (output) REAL array, dimension (2) -* The maximum over the NRHS solution vectors of the ratios: -* RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR ) -* RESLTS(2) = BERR / ( (n+1)*EPS + (*) ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IMAX, J, K - REAL AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM - COMPLEX ZDUM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ICAMAX - REAL SLAMCH - EXTERNAL LSAME, ICAMAX, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, MIN, REAL -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESLTS( 1 ) = ZERO - RESLTS( 2 ) = ZERO - RETURN - END IF -* - EPS = SLAMCH( 'Epsilon' ) - UNFL = SLAMCH( 'Safe minimum' ) - OVFL = ONE / UNFL - UPPER = LSAME( UPLO, 'U' ) -* -* Test 1: Compute the maximum of -* norm(X - XACT) / ( norm(X) * FERR ) -* over all the vectors X and XACT using the infinity-norm. -* - ERRBND = ZERO - DO 30 J = 1, NRHS - IMAX = ICAMAX( N, X( 1, J ), 1 ) - XNORM = MAX( CABS1( X( IMAX, J ) ), UNFL ) - DIFF = ZERO - DO 10 I = 1, N - DIFF = MAX( DIFF, CABS1( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE -* - IF( XNORM.GT.ONE ) THEN - GO TO 20 - ELSE IF( DIFF.LE.OVFL*XNORM ) THEN - GO TO 20 - ELSE - ERRBND = ONE / EPS - GO TO 30 - END IF -* - 20 CONTINUE - IF( DIFF / XNORM.LE.FERR( J ) ) THEN - ERRBND = MAX( ERRBND, ( DIFF / XNORM ) / FERR( J ) ) - ELSE - ERRBND = ONE / EPS - END IF - 30 CONTINUE - RESLTS( 1 ) = ERRBND -* -* Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* - DO 90 K = 1, NRHS - DO 80 I = 1, N - TMP = CABS1( B( I, K ) ) - IF( UPPER ) THEN - DO 40 J = 1, I - 1 - TMP = TMP + CABS1( A( J, I ) )*CABS1( X( J, K ) ) - 40 CONTINUE - TMP = TMP + ABS( REAL( A( I, I ) ) )*CABS1( X( I, K ) ) - DO 50 J = I + 1, N - TMP = TMP + CABS1( A( I, J ) )*CABS1( X( J, K ) ) - 50 CONTINUE - ELSE - DO 60 J = 1, I - 1 - TMP = TMP + CABS1( A( I, J ) )*CABS1( X( J, K ) ) - 60 CONTINUE - TMP = TMP + ABS( REAL( A( I, I ) ) )*CABS1( X( I, K ) ) - DO 70 J = I + 1, N - TMP = TMP + CABS1( A( J, I ) )*CABS1( X( J, K ) ) - 70 CONTINUE - END IF - IF( I.EQ.1 ) THEN - AXBI = TMP - ELSE - AXBI = MIN( AXBI, TMP ) - END IF - 80 CONTINUE - TMP = BERR( K ) / ( ( N+1 )*EPS+( N+1 )*UNFL / - $ MAX( AXBI, ( N+1 )*UNFL ) ) - IF( K.EQ.1 ) THEN - RESLTS( 2 ) = TMP - ELSE - RESLTS( 2 ) = MAX( RESLTS( 2 ), TMP ) - END IF - 90 CONTINUE -* - RETURN -* -* End of CPOT05 -* - END diff --git a/testing/lin/cpotri.f b/testing/lin/cpotri.f deleted file mode 100644 index dea6b9d014c2decdf596c8492d7de923d65d87cf..0000000000000000000000000000000000000000 --- a/testing/lin/cpotri.f +++ /dev/null @@ -1,133 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CPOTRI( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CPOTRI computes the inverse of a complex Hermitian positive definite -* matrix A using the Cholesky factorization A = U^H*U or A = L*L^H -* computed by CPOTRF. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H, as computed by -* CPOTRF. -* On exit, the upper or lower triangle of the (Hermitian) -* inverse of A, overwriting the input factor U or L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the (i,i) element of the factor U or L is -* zero, and the inverse could not be computed. -* -* ===================================================================== -* -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL CLAUUM, CTRTRI, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CPOTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Invert the triangular Cholesky factor U or L. -* - CALL CTRTRI( UPLO, 'Non-unit', N, A, LDA, INFO ) - IF( INFO.GT.0 ) - $ RETURN -* -* Form inv(U)*inv(U)' or inv(L)'*inv(L). -* - CALL CLAUUM( UPLO, N, A, LDA, INFO ) -* - RETURN -* -* End of CPOTRI -* - END diff --git a/testing/lin/cqrt01.f b/testing/lin/cqrt01.f deleted file mode 100644 index 35685ca8dd2172dddc46ba2e77171feb63072bb0..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt01.f +++ /dev/null @@ -1,194 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT01( M, N, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CQRT01 tests CGEQRF, which computes the QR factorization of an m-by-n -* matrix A, and partially tests CUNGQR which forms the m-by-m -* orthogonal matrix Q. -* -* CQRT01 compares R with Q'*A, and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) COMPLEX array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by CGEQRF. -* See CGEQRF for further details. -* -* Q (output) COMPLEX array, dimension (LDA,M) -* The m-by-m orthogonal matrix Q. -* -* R (workspace) COMPLEX array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. -* LDA >= max(M,N). -* -* TAU (output) COMPLEX array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by CGEQRF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL CLANGE, CLANSY, SLAMCH - EXTERNAL CLANGE, CLANSY, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CGEQRF, CHERK, CLACPY, CLASET, CUNGQR -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, MIN, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'CGEQRF' - CALL CHAMELEON_CGEQRF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL CLASET( 'Full', M, N, CMPLX(ZERO), CMPLX(ONE), Q, LDA ) -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'CUNGQR' - CALL CHAMELEON_CUNGQR( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R -* - CALL CLASET( 'Full', N, N, CMPLX( ZERO ), CMPLX( ZERO ), R, LDA ) - CALL CLACPY( 'Upper', N, N, AF, LDA, R, LDA ) -* -* Compute R - Q'*A -* - CALL CGEMM( 'Conjugate transpose', 'No transpose', N, N, M, - $ CMPLX( -ONE ), Q, LDA, A, LDA, CMPLX( ONE ), R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = CLANGE( '1', M, N, A, LDA, RWORK ) - RESID = CLANGE( '1', N, N, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL CLASET( 'Full', N, N, CMPLX( ZERO ), CMPLX( ONE ), R, LDA ) - CALL CHERK( 'Upper', 'Conjugate transpose', N, M, ONE, Q, LDA, - $ -ONE, R, LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = CLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of CQRT01 -* - END diff --git a/testing/lin/cqrt02.f b/testing/lin/cqrt02.f deleted file mode 100644 index 6cec0fa0037e51fd020ebb2fa4f3076e93b1fbcd..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT02( M, N, K, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CQRT02 tests CUNGQR, which generates an m-by-n matrix Q with -* orthonornmal columns that is defined as the product of k elementary -* reflectors. -* -* Given the QR factorization of an m-by-n matrix A, CQRT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* columns of A; it compares R(1:n,1:k) with Q(1:m,1:n)'*A(1:m,1:k), -* and checks that the columns of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* M >= N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. N >= K >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by CQRT01. -* -* AF (input) COMPLEX array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by CGEQRF. -* See CGEQRF for further details. -* -* Q (workspace) COMPLEX array, dimension (LDA,N) -* -* R (workspace) COMPLEX array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. LDA >= M. -* -* TAU (input) COMPLEX array, dimension (N) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL CLANGE, CLANSY, SLAMCH - EXTERNAL CLANGE, CLANSY, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CHERK, CLACPY, CLASET, CUNGQR -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k columns of the factorization to the array Q -* - CALL CLASET( 'Full', M, N, CMPLX(ZERO), CMPLX(ONE), Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'CUNGQR' - CALL CHAMELEON_CUNGQR( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R(1:n,1:k) -* - CALL CLASET( 'Full', N, K, CMPLX( ZERO ), CMPLX( ZERO ), R, LDA ) - CALL CLACPY( 'Upper', N, K, AF, LDA, R, LDA ) -* -* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) -* - CALL CGEMM( 'Conjugate transpose', 'No transpose', N, K, M, - $ CMPLX( -ONE ), Q, LDA, A, LDA, CMPLX( ONE ), R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = CLANGE( '1', M, K, A, LDA, RWORK ) - RESID = CLANGE( '1', N, K, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL CLASET( 'Full', N, N, CMPLX( ZERO ), CMPLX( ONE ), R, LDA ) - CALL CHERK( 'Upper', 'Conjugate transpose', N, M, -ONE, Q, LDA, - $ ONE, R, LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = CLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of CQRT02 -* - END diff --git a/testing/lin/cqrt03.f b/testing/lin/cqrt03.f deleted file mode 100644 index 435f52aa4d5c3fbe66d376de579ac7ccdd74160c..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt03.f +++ /dev/null @@ -1,239 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL RESULT( * ), RWORK( * ) - COMPLEX AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CQRT03 tests CUNMQR, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* CQRT03 compares the results of a call to CUNMQR with the results of -* forming Q explicitly by a call to CUNGQR and then performing matrix -* multiplication by a call to CGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The order of the orthogonal matrix Q. M >= 0. -* -* N (input) INTEGER -* The number of rows or columns of the matrix C; C is m-by-n if -* Q is applied from the left, or n-by-m if Q is applied from -* the right. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. M >= K >= 0. -* -* AF (input) COMPLEX array, dimension (LDA,N) -* Details of the QR factorization of an m-by-n matrix, as -* returnedby CGEQRF. See CGEQRF for further details. -* -* C (workspace) COMPLEX array, dimension (LDA,N) -* -* CC (workspace) COMPLEX array, dimension (LDA,N) -* -* Q (workspace) COMPLEX array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) COMPLEX array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an m-by-m orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( M * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( M * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( M * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( M * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX ROGUE - PARAMETER ( ROGUE = ( -1.0E+10, -1.0E+10 ) ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - REAL CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLARNV, CLASET, CUNGQR, CUNMQR -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) - WORK(1) = ONE -* -* Copy the first k columns of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL CLASET( 'Full', M, M, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL CLASET( 'Full', M, M, CMPLX(ZERO), CMPLX(ONE), Q, LDA ) - ENDIF -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'CUNGQR' - CALL CHAMELEON_CUNGQR( M, M, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = M - NC = N - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = N - NC = M - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL CLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = CLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.ZERO ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - END IF -* -* Copy C -* - CALL CLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'CUNMQR' - CALL CHAMELEON_CUNMQR( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL CLASET( 'Full', M, M, CMPLX(ZERO), CMPLX(ONE), - $ Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL CGEMM( TRANS, 'No transpose', MC, NC, MC, - $ CMPLX( -ONE ), Q, LDA, C, LDA, CMPLX( ONE ), - $ CC, LDA ) - ELSE - CALL CGEMM( 'No transpose', TRANS, MC, NC, NC, - $ CMPLX( -ONE ), C, LDA, Q, LDA, CMPLX( ONE ), - $ CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = CLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( REAL( MAX( 1, M ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of CQRT03 -* - END diff --git a/testing/lin/cqrt13.f b/testing/lin/cqrt13.f deleted file mode 100644 index b65226a5e9d30145ab69a8dee6c523732ff67b81..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt13.f +++ /dev/null @@ -1,153 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, M, N, SCALE - REAL NORMA -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CQRT13 generates a full-rank matrix that may be scaled to have large -* or small norm. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (output) COMPLEX array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* NORMA (output) REAL -* The one-norm of A. -* -* ISEED (input/output) integer array, dimension (4) -* Seed for random number generator -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J - REAL BIGNUM, SMLNUM -* .. -* .. External Functions .. - REAL CLANGE, SCASUM, SLAMCH - EXTERNAL CLANGE, SCASUM, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CLARNV, CLASCL, SLABAD -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, REAL, SIGN -* .. -* .. Local Arrays .. - REAL DUMMY( 1 ) -* .. -* .. Executable Statements .. -* - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN -* -* benign matrix -* - DO 10 J = 1, N - CALL CLARNV( 2, ISEED, M, A( 1, J ) ) - IF( J.LE.M ) THEN - A( J, J ) = A( J, J ) + CMPLX( SIGN( SCASUM( M, A( 1, J ), - $ 1 ), REAL( A( J, J ) ) ) ) - END IF - 10 CONTINUE -* -* scaled versions -* - IF( SCALE.NE.1 ) THEN - NORMA = CLANGE( 'Max', M, N, A, LDA, DUMMY ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / SLAMCH( 'Epsilon' ) - BIGNUM = ONE / SMLNUM -* - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL CLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA, - $ INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL CLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA, - $ INFO ) - END IF - END IF -* - NORMA = CLANGE( 'One-norm', M, N, A, LDA, DUMMY ) - RETURN -* -* End of CQRT13 -* - END diff --git a/testing/lin/cqrt14.f b/testing/lin/cqrt14.f deleted file mode 100644 index 37884ed1c53cbaeab73850830f01f029c27d6350..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt14.f +++ /dev/null @@ -1,228 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION CQRT14( TRANS, M, N, NRHS, A, LDA, X, - $ LDX, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ), WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CQRT14 checks whether X is in the row space of A or A'. It does so -* by scaling both X and A such that their norms are in the range -* [sqrt(eps), 1/sqrt(eps)], then computing a QR factorization of [A,X] -* (if TRANS = 'C') or an LQ factorization of [A',X]' (if TRANS = 'N'), -* and returning the norm of the trailing triangle, scaled by -* MAX(M,N,NRHS)*eps. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* = 'N': No transpose, check for X in the row space of A -* = 'C': Conjugate transpose, check for X in row space of A'. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of X. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* If TRANS = 'N', the N-by-NRHS matrix X. -* IF TRANS = 'C', the M-by-NRHS matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* -* WORK (workspace) COMPLEX array dimension (LWORK) -* -* LWORK (input) INTEGER -* length of workspace array required -* If TRANS = 'N', LWORK >= (M+NRHS)*(N+2); -* if TRANS = 'C', LWORK >= (N+NRHS)*(M+2). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL TPSD - INTEGER I, INFO, J, LDWORK - REAL ANRM, ERR, XNRM -* .. -* .. Local Arrays .. - REAL RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGELQ2, CGEQR2, CLACPY, CLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, CONJG, MAX, MIN, REAL -* .. -* .. Executable Statements .. -* - CQRT14 = ZERO - IF( LSAME( TRANS, 'N' ) ) THEN - LDWORK = M + NRHS - TPSD = .FALSE. - IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN - CALL XERBLA( 'CQRT14', 10 ) - RETURN - ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE IF( LSAME( TRANS, 'C' ) ) THEN - LDWORK = M - TPSD = .TRUE. - IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN - CALL XERBLA( 'CQRT14', 10 ) - RETURN - ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE - CALL XERBLA( 'CQRT14', 1 ) - RETURN - END IF -* -* Copy and scale A -* - CALL CLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) - ANRM = CLANGE( 'M', M, N, WORK, LDWORK, RWORK ) - IF( ANRM.NE.ZERO ) - $ CALL CLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) -* -* Copy X or X' into the right place and scale it -* - IF( TPSD ) THEN -* -* Copy X into columns n+1:n+nrhs of work -* - CALL CLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), - $ LDWORK ) - XNRM = CLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, - $ RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL CLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, - $ WORK( N*LDWORK+1 ), LDWORK, INFO ) - ANRM = CLANGE( 'One-norm', M, N+NRHS, WORK, LDWORK, RWORK ) -* -* Compute QR factorization of X -* - CALL CGEQR2( M, N+NRHS, WORK, LDWORK, - $ WORK( LDWORK*( N+NRHS )+1 ), - $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), - $ INFO ) -* -* Compute largest entry in upper triangle of -* work(n+1:m,n+1:n+nrhs) -* - ERR = ZERO - DO 20 J = N + 1, N + NRHS - DO 10 I = N + 1, MIN( M, J ) - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) - 10 CONTINUE - 20 CONTINUE -* - ELSE -* -* Copy X' into rows m+1:m+nrhs of work -* - DO 40 I = 1, N - DO 30 J = 1, NRHS - WORK( M+J+( I-1 )*LDWORK ) = CONJG( X( I, J ) ) - 30 CONTINUE - 40 CONTINUE -* - XNRM = CLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL CLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), - $ LDWORK, INFO ) -* -* Compute LQ factorization of work -* - CALL CGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), - $ WORK( LDWORK*( N+1 )+1 ), INFO ) -* -* Compute largest entry in lower triangle in -* work(m+1:m+nrhs,m+1:n) -* - ERR = ZERO - DO 60 J = M + 1, N - DO 50 I = J, LDWORK - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) - 50 CONTINUE - 60 CONTINUE -* - END IF -* - CQRT14 = ERR / ( REAL( MAX( M, N, NRHS ) )*SLAMCH( 'Epsilon' ) ) -* - RETURN -* -* End of CQRT14 -* - END diff --git a/testing/lin/cqrt15.f b/testing/lin/cqrt15.f deleted file mode 100644 index d5f3ebbdce82cb2ca7e8a1888e51ed1db7a0fcd6..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt15.f +++ /dev/null @@ -1,269 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, - $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE - REAL NORMA, NORMB -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL S( * ) - COMPLEX A( LDA, * ), B( LDB, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* CQRT15 generates a matrix with full or deficient rank and of various -* norms. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* RKSEL (input) INTEGER -* RKSEL = 1: full rank matrix -* RKSEL = 2: rank-deficient matrix -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* NRHS (input) INTEGER -* The number of columns of B. -* -* A (output) COMPLEX array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* B (output) COMPLEX array, dimension (LDB, NRHS) -* A matrix that is in the range space of matrix A. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* -* S (output) REAL array, dimension MIN(M,N) -* Singular values of A. -* -* RANK (output) INTEGER -* number of nonzero singular values of A. -* -* NORMA (output) REAL -* one-norm norm of A. -* -* NORMB (output) REAL -* one-norm norm of B. -* -* ISEED (input/output) integer array, dimension (4) -* seed for random number generator. -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* length of work space required. -* LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, TWO, SVMIN - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0, - $ SVMIN = 0.1E+0 ) - COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), - $ CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, J, MN - REAL BIGNUM, EPS, SMLNUM, TEMP -* .. -* .. Local Arrays .. - REAL DUMMY( 1 ) -* .. -* .. External Functions .. - REAL CLANGE, SASUM, SCNRM2, SLAMCH, SLARND - EXTERNAL CLANGE, SASUM, SCNRM2, SLAMCH, SLARND -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CLARF, CLARNV, CLAROR, CLASCL, CLASET, - $ CSSCAL, SLABAD, SLAORD, SLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, CMPLX, MAX, MIN -* .. -* .. Executable Statements .. -* - MN = MIN( M, N ) - IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN - CALL XERBLA( 'CQRT15', 16 ) - RETURN - END IF -* - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) - EPS = SLAMCH( 'Epsilon' ) - SMLNUM = ( SMLNUM / EPS ) / EPS - BIGNUM = ONE / SMLNUM -* -* Determine rank and (unscaled) singular values -* - IF( RKSEL.EQ.1 ) THEN - RANK = MN - ELSE IF( RKSEL.EQ.2 ) THEN - RANK = ( 3*MN ) / 4 - DO 10 J = RANK + 1, MN - S( J ) = ZERO - 10 CONTINUE - ELSE - CALL XERBLA( 'CQRT15', 2 ) - END IF -* - IF( RANK.GT.0 ) THEN -* -* Nontrivial case -* - S( 1 ) = ONE - DO 30 J = 2, RANK - 20 CONTINUE - TEMP = SLARND( 1, ISEED ) - IF( TEMP.GT.SVMIN ) THEN - S( J ) = ABS( TEMP ) - ELSE - GO TO 20 - END IF - 30 CONTINUE - CALL SLAORD( 'Decreasing', RANK, S, 1 ) -* -* Generate 'rank' columns of a random orthogonal matrix in A -* - CALL CLARNV( 2, ISEED, M, WORK ) - CALL CSSCAL( M, ONE / SCNRM2( M, WORK, 1 ), WORK, 1 ) - CALL CLASET( 'Full', M, RANK, CZERO, CONE, A, LDA ) - CALL CLARF( 'Left', M, RANK, WORK, 1, CMPLX( TWO ), A, LDA, - $ WORK( M+1 ) ) -* -* workspace used: m+mn -* -* Generate consistent rhs in the range space of A -* - CALL CLARNV( 2, ISEED, RANK*NRHS, WORK ) - CALL CGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, - $ CONE, A, LDA, WORK, RANK, CZERO, B, LDB ) -* -* work space used: <= mn *nrhs -* -* generate (unscaled) matrix A -* - DO 40 J = 1, RANK - CALL CSSCAL( M, S( J ), A( 1, J ), 1 ) - 40 CONTINUE - IF( RANK.LT.N ) - $ CALL CLASET( 'Full', M, N-RANK, CZERO, CZERO, - $ A( 1, RANK+1 ), LDA ) - CALL CLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, - $ WORK, INFO ) -* - ELSE -* -* work space used 2*n+m -* -* Generate null matrix and rhs -* - DO 50 J = 1, MN - S( J ) = ZERO - 50 CONTINUE - CALL CLASET( 'Full', M, N, CZERO, CZERO, A, LDA ) - CALL CLASET( 'Full', M, NRHS, CZERO, CZERO, B, LDB ) -* - END IF -* -* Scale the matrix -* - IF( SCALE.NE.1 ) THEN - NORMA = CLANGE( 'Max', M, N, A, LDA, DUMMY ) - IF( NORMA.NE.ZERO ) THEN - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL CLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, - $ LDA, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, - $ MN, INFO ) - CALL CLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL CLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, - $ LDA, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, - $ MN, INFO ) - CALL CLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE - CALL XERBLA( 'CQRT15', 1 ) - RETURN - END IF - END IF - END IF -* - NORMA = SASUM( MN, S, 1 ) - NORMB = CLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) -* - RETURN -* -* End of CQRT15 -* - END diff --git a/testing/lin/cqrt16.f b/testing/lin/cqrt16.f deleted file mode 100644 index 67135642a480687912968c67a2a3714aa6c7dc6b..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt16.f +++ /dev/null @@ -1,182 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CQRT16( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CQRT16 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A^T*x = b, where A^T is the transpose of A -* = 'C': A^H*x = b, where A^H is the conjugate transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) COMPLEX array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - COMPLEX CONE - PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - REAL ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SCASUM, SLAMCH - EXTERNAL LSAME, CLANGE, SCASUM, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - ANORM = CLANGE( 'I', M, N, A, LDA, RWORK ) - N1 = N - N2 = M - ELSE - ANORM = CLANGE( '1', M, N, A, LDA, RWORK ) - N1 = M - N2 = N - END IF - RHSNORM = CLANGE( 'I', N, NRHS, B, LDB, RWORK ) -* - EPS = SLAMCH( 'Epsilon' ) -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL CGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X, - $ LDX, CONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SCASUM( N1, B( 1, J ), 1 ) - XNORM = SCASUM( N2, X( 1, J ), 1 ) - IF( ANORM.EQ.ZERO .AND. BNORM.EQ.ZERO ) THEN - RESID = ZERO - ELSE IF( ANORM.LE.ZERO .OR. XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM )/ (ANORM *XNORM + RHSNORM ) * - $ ( MAX( M, N )*EPS ) ) - END IF - 10 CONTINUE -* - RETURN -* -* End of CQRT16 -* - END diff --git a/testing/lin/cqrt17.f b/testing/lin/cqrt17.f deleted file mode 100644 index 801e5761fd8efd8b3de21721df9577575caefd3a..0000000000000000000000000000000000000000 --- a/testing/lin/cqrt17.f +++ /dev/null @@ -1,217 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION CQRT17( TRANS, IRESID, M, N, NRHS, A, - $ LDA, X, LDX, B, LDB, C, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER IRESID, LDA, LDB, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ), B( LDB, * ), C( LDB, * ), - $ WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* CQRT17 computes the ratio -* -* || R'*op(A) ||/(||A||*alpha*max(M,N,NRHS)*eps) -* -* where R = op(A)*X - B, op(A) is A or A', and -* -* alpha = ||B|| if IRESID = 1 (zero-residual problem) -* alpha = ||R|| if IRESID = 2 (otherwise). -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies whether or not the transpose of A is used. -* = 'N': No transpose, op(A) = A. -* = 'C': Conjugate transpose, op(A) = A'. -* -* IRESID (input) INTEGER -* IRESID = 1 indicates zero-residual problem. -* IRESID = 2 indicates non-zero residual. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* If TRANS = 'N', the number of rows of the matrix B. -* If TRANS = 'C', the number of rows of the matrix X. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* If TRANS = 'N', the number of rows of the matrix X. -* If TRANS = 'C', the number of rows of the matrix B. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and B. -* -* A (input) COMPLEX array, dimension (LDA,N) -* The m-by-n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* X (input) COMPLEX array, dimension (LDX,NRHS) -* If TRANS = 'N', the n-by-nrhs matrix X. -* If TRANS = 'C', the m-by-nrhs matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* If TRANS = 'N', LDX >= N. -* If TRANS = 'C', LDX >= M. -* -* B (input) COMPLEX array, dimension (LDB,NRHS) -* If TRANS = 'N', the m-by-nrhs matrix B. -* If TRANS = 'C', the n-by-nrhs matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* If TRANS = 'N', LDB >= M. -* If TRANS = 'C', LDB >= N. -* -* C (workspace) COMPLEX array, dimension (LDB,NRHS) -* -* WORK (workspace) COMPLEX array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of the array WORK. LWORK >= NRHS*(M+N). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, ISCL, NCOLS, NROWS - REAL BIGNUM, ERR, NORMA, NORMB, NORMRS, NORMX, - $ SMLNUM -* .. -* .. Local Arrays .. - REAL RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC CMPLX, MAX, REAL -* .. -* .. Executable Statements .. -* - CQRT17 = ZERO -* - IF( LSAME( TRANS, 'N' ) ) THEN - NROWS = M - NCOLS = N - ELSE IF( LSAME( TRANS, 'C' ) ) THEN - NROWS = N - NCOLS = M - ELSE - CALL XERBLA( 'CQRT17', 1 ) - RETURN - END IF -* - IF( LWORK.LT.NCOLS*NRHS ) THEN - CALL XERBLA( 'CQRT17', 13 ) - RETURN - END IF -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) - $ RETURN -* - NORMA = CLANGE( 'One-norm', M, N, A, LDA, RWORK ) - SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - ISCL = 0 -* -* compute residual and scale it -* - CALL CLACPY( 'All', NROWS, NRHS, B, LDB, C, LDB ) - CALL CGEMM( TRANS, 'No transpose', NROWS, NRHS, NCOLS, - $ CMPLX( -ONE ), A, LDA, X, LDX, CMPLX( ONE ), C, LDB ) - NORMRS = CLANGE( 'Max', NROWS, NRHS, C, LDB, RWORK ) - IF( NORMRS.GT.SMLNUM ) THEN - ISCL = 1 - CALL CLASCL( 'General', 0, 0, NORMRS, ONE, NROWS, NRHS, C, LDB, - $ INFO ) - END IF -* -* compute R'*A -* - CALL CGEMM( 'Conjugate transpose', TRANS, NRHS, NCOLS, NROWS, - $ CMPLX( ONE ), C, LDB, A, LDA, CMPLX( ZERO ), WORK, - $ NRHS ) -* -* compute and properly scale error -* - ERR = CLANGE( 'One-norm', NRHS, NCOLS, WORK, NRHS, RWORK ) - IF( NORMA.NE.ZERO ) - $ ERR = ERR / NORMA -* - IF( ISCL.EQ.1 ) - $ ERR = ERR*NORMRS -* - IF( IRESID.EQ.1 ) THEN - NORMB = CLANGE( 'One-norm', NROWS, NRHS, B, LDB, RWORK ) - IF( NORMB.NE.ZERO ) - $ ERR = ERR / NORMB - ELSE - NORMX = CLANGE( 'One-norm', NCOLS, NRHS, X, LDX, RWORK ) - IF( NORMX.NE.ZERO ) - $ ERR = ERR / NORMX - END IF -* - CQRT17 = ERR / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N, NRHS ) ) ) - RETURN -* -* End of CQRT17 -* - END diff --git a/testing/lin/csbmv.f b/testing/lin/csbmv.f deleted file mode 100644 index 0d0de773a4c77aa56a6723f1286c61b10b96482e..0000000000000000000000000000000000000000 --- a/testing/lin/csbmv.f +++ /dev/null @@ -1,343 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, - $ INCY ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, K, LDA, N - COMPLEX ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* CSBMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric band matrix, with k super-diagonals. -* -* Arguments -* ========== -* -* UPLO - CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the band matrix A is being supplied as -* follows: -* -* UPLO = 'U' or 'u' The upper triangular part of A is -* being supplied. -* -* UPLO = 'L' or 'l' The lower triangular part of A is -* being supplied. -* -* Unchanged on exit. -* -* N - INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* K - INTEGER -* On entry, K specifies the number of super-diagonals of the -* matrix A. K must satisfy 0 .le. K. -* Unchanged on exit. -* -* ALPHA - COMPLEX -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* A - COMPLEX array, dimension( LDA, N ) -* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) -* by n part of the array A must contain the upper triangular -* band part of the symmetric matrix, supplied column by -* column, with the leading diagonal of the matrix in row -* ( k + 1 ) of the array, the first super-diagonal starting at -* position 2 in row k, and so on. The top left k by k triangle -* of the array A is not referenced. -* The following program segment will transfer the upper -* triangular part of a symmetric band matrix from conventional -* full matrix storage to band storage: -* -* DO 20, J = 1, N -* M = K + 1 - J -* DO 10, I = MAX( 1, J - K ), J -* A( M + I, J ) = matrix( I, J ) -* 10 CONTINUE -* 20 CONTINUE -* -* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) -* by n part of the array A must contain the lower triangular -* band part of the symmetric matrix, supplied column by -* column, with the leading diagonal of the matrix in row 1 of -* the array, the first sub-diagonal starting at position 1 in -* row 2, and so on. The bottom right k by k triangle of the -* array A is not referenced. -* The following program segment will transfer the lower -* triangular part of a symmetric band matrix from conventional -* full matrix storage to band storage: -* -* DO 20, J = 1, N -* M = 1 - J -* DO 10, I = J, MIN( N, J + K ) -* A( M + I, J ) = matrix( I, J ) -* 10 CONTINUE -* 20 CONTINUE -* -* Unchanged on exit. -* -* LDA - INTEGER -* On entry, LDA specifies the first dimension of A as declared -* in the calling (sub) program. LDA must be at least -* ( k + 1 ). -* Unchanged on exit. -* -* X - COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the -* vector x. -* Unchanged on exit. -* -* INCX - INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA - COMPLEX -* On entry, BETA specifies the scalar beta. -* Unchanged on exit. -* -* Y - COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the -* vector y. On exit, Y is overwritten by the updated vector y. -* -* INCY - INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) - COMPLEX ZERO - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L - COMPLEX TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( K.LT.0 ) THEN - INFO = 3 - ELSE IF( LDA.LT.( K+1 ) ) THEN - INFO = 6 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 8 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CSBMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of the array A -* are accessed sequentially with one pass through A. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when upper triangle of A is stored. -* - KPLUS1 = K + 1 - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - L = KPLUS1 - J - DO 50 I = MAX( 1, J-K ), J - 1 - Y( I ) = Y( I ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( I ) - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - L = KPLUS1 - J - DO 70 I = MAX( 1, J-K ), J - 1 - Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - IF( J.GT.K ) THEN - KX = KX + INCX - KY = KY + INCY - END IF - 80 CONTINUE - END IF - ELSE -* -* Form y when lower triangle of A is stored. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*A( 1, J ) - L = 1 - J - DO 90 I = J + 1, MIN( N, J+K ) - Y( I ) = Y( I ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( I ) - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*A( 1, J ) - L = 1 - J - IX = JX - IY = JY - DO 110 I = J + 1, MIN( N, J+K ) - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of CSBMV -* - END diff --git a/testing/lin/cspmv.f b/testing/lin/cspmv.f deleted file mode 100644 index de9bffb5d94923b9477bb40ade7f94ec6798d06a..0000000000000000000000000000000000000000 --- a/testing/lin/cspmv.f +++ /dev/null @@ -1,302 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, N - COMPLEX ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX AP( * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* CSPMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric matrix, supplied in packed form. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the matrix A is supplied in the packed -* array AP as follows: -* -* UPLO = 'U' or 'u' The upper triangular part of A is -* supplied in AP. -* -* UPLO = 'L' or 'l' The lower triangular part of A is -* supplied in AP. -* -* Unchanged on exit. -* -* N (input) INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* ALPHA (input) COMPLEX -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* AP (input) COMPLEX array, dimension at least -* ( ( N*( N + 1 ) )/2 ). -* Before entry, with UPLO = 'U' or 'u', the array AP must -* contain the upper triangular part of the symmetric matrix -* packed sequentially, column by column, so that AP( 1 ) -* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) -* and a( 2, 2 ) respectively, and so on. -* Before entry, with UPLO = 'L' or 'l', the array AP must -* contain the lower triangular part of the symmetric matrix -* packed sequentially, column by column, so that AP( 1 ) -* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) -* and a( 3, 1 ) respectively, and so on. -* Unchanged on exit. -* -* X (input) COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the N- -* element vector x. -* Unchanged on exit. -* -* INCX (input) INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA (input) COMPLEX -* On entry, BETA specifies the scalar beta. When BETA is -* supplied as zero then Y need not be set on input. -* Unchanged on exit. -* -* Y (input/output) COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the n -* element vector y. On exit, Y is overwritten by the updated -* vector y. -* -* INCY (input) INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) - COMPLEX ZERO - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY - COMPLEX TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 6 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 9 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CSPMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of the array AP -* are accessed sequentially with one pass through AP. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - KK = 1 - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when AP contains the upper triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - K = KK - DO 50 I = 1, J - 1 - Y( I ) = Y( I ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( I ) - K = K + 1 - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2 - KK = KK + J - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - DO 70 K = KK, KK + J - 2 - Y( IY ) = Y( IY ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - KK = KK + J - 80 CONTINUE - END IF - ELSE -* -* Form y when AP contains the lower triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*AP( KK ) - K = KK + 1 - DO 90 I = J + 1, N - Y( I ) = Y( I ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( I ) - K = K + 1 - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - KK = KK + ( N-J+1 ) - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*AP( KK ) - IX = JX - IY = JY - DO 110 K = KK + 1, KK + N - J - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - KK = KK + ( N-J+1 ) - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of CSPMV -* - END diff --git a/testing/lin/csrscl.f b/testing/lin/csrscl.f deleted file mode 100644 index 93c55ac3a82ff8b3d2328df4b13f21347c1e67ff..0000000000000000000000000000000000000000 --- a/testing/lin/csrscl.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CSRSCL( N, SA, SX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N - REAL SA -* .. -* .. Array Arguments .. - COMPLEX SX( * ) -* .. -* -* Purpose -* ======= -* -* CSRSCL multiplies an n-element complex vector x by the real scalar -* 1/a. This is done without overflow or underflow as long as -* the final result x/a does not overflow or underflow. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of components of the vector x. -* -* SA (input) REAL -* The scalar a which is used to divide each component of x. -* SA must be >= 0, or the subroutine will divide by zero. -* -* SX (input/output) COMPLEX array, dimension -* (1+(N-1)*abs(INCX)) -* The n-element vector x. -* -* INCX (input) INTEGER -* The increment between successive values of the vector SX. -* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CSSCAL, SLABAD -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) -* -* Initialize the denominator to SA and the numerator to 1. -* - CDEN = SA - CNUM = ONE -* - 10 CONTINUE - CDEN1 = CDEN*SMLNUM - CNUM1 = CNUM / BIGNUM - IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN -* -* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. -* - MUL = SMLNUM - DONE = .FALSE. - CDEN = CDEN1 - ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN -* -* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. -* - MUL = BIGNUM - DONE = .FALSE. - CNUM = CNUM1 - ELSE -* -* Multiply X by CNUM / CDEN and return. -* - MUL = CNUM / CDEN - DONE = .TRUE. - END IF -* -* Scale the vector X by MUL -* - CALL CSSCAL( N, MUL, SX, INCX ) -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of CSRSCL -* - END diff --git a/testing/lin/csymv.f b/testing/lin/csymv.f deleted file mode 100644 index eeb4150dad8dcf6d74a7cd433458b15225feac45..0000000000000000000000000000000000000000 --- a/testing/lin/csymv.f +++ /dev/null @@ -1,302 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, LDA, N - COMPLEX ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* CSYMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric matrix. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the array A is to be referenced as -* follows: -* -* UPLO = 'U' or 'u' Only the upper triangular part of A -* is to be referenced. -* -* UPLO = 'L' or 'l' Only the lower triangular part of A -* is to be referenced. -* -* Unchanged on exit. -* -* N (input) INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* ALPHA (input) COMPLEX -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* A (input) COMPLEX array, dimension ( LDA, N ) -* Before entry, with UPLO = 'U' or 'u', the leading n by n -* upper triangular part of the array A must contain the upper -* triangular part of the symmetric matrix and the strictly -* lower triangular part of A is not referenced. -* Before entry, with UPLO = 'L' or 'l', the leading n by n -* lower triangular part of the array A must contain the lower -* triangular part of the symmetric matrix and the strictly -* upper triangular part of A is not referenced. -* Unchanged on exit. -* -* LDA (input) INTEGER -* On entry, LDA specifies the first dimension of A as declared -* in the calling (sub) program. LDA must be at least -* max( 1, N ). -* Unchanged on exit. -* -* X (input) COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the N- -* element vector x. -* Unchanged on exit. -* -* INCX (input) INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA (input) COMPLEX -* On entry, BETA specifies the scalar beta. When BETA is -* supplied as zero then Y need not be set on input. -* Unchanged on exit. -* -* Y (input/output) COMPLEX array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the n -* element vector y. On exit, Y is overwritten by the updated -* vector y. -* -* INCY (input) INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) - COMPLEX ZERO - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY - COMPLEX TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = 5 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 7 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 10 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CSYMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of A are -* accessed sequentially with one pass through the triangular part -* of A. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when A is stored in upper triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - DO 50 I = 1, J - 1 - Y( I ) = Y( I ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( I ) - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2 - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - DO 70 I = 1, J - 1 - Y( IY ) = Y( IY ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 80 CONTINUE - END IF - ELSE -* -* Form y when A is stored in lower triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*A( J, J ) - DO 90 I = J + 1, N - Y( I ) = Y( I ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( I ) - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*A( J, J ) - IX = JX - IY = JY - DO 110 I = J + 1, N - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of CSYMV -* - END diff --git a/testing/lin/ctest.in b/testing/lin/ctest.in deleted file mode 100644 index 4333a81fa413c1d265f0751a66d8bcd809aab76d..0000000000000000000000000000000000000000 --- a/testing/lin/ctest.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing REAL COMPLEX CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -0 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -CGE 11 List types on next line if 0 < NTYPES < 11 -CPO 9 List types on next line if 0 < NTYPES < 9 -CLS 6 List types on next line if 0 < NTYPES < 6 -CQR 8 List types on next line if 0 < NTYPES < 8 -CLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/ctestdyn.in b/testing/lin/ctestdyn.in deleted file mode 100644 index 17df04f148e8e45d07b733a9598234f601887b8b..0000000000000000000000000000000000000000 --- a/testing/lin/ctestdyn.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing REAL COMPLEX CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -1 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -CGE 11 List types on next line if 0 < NTYPES < 11 -CPO 9 List types on next line if 0 < NTYPES < 9 -CLS 6 List types on next line if 0 < NTYPES < 6 -CQR 8 List types on next line if 0 < NTYPES < 8 -CLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/ctrti2.f b/testing/lin/ctrti2.f deleted file mode 100644 index 96edb3320c9522e8f8490ac7743902460e3c79ff..0000000000000000000000000000000000000000 --- a/testing/lin/ctrti2.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CTRTI2( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CTRTI2 computes the inverse of a complex upper or lower triangular -* matrix. -* -* This is the Level 2 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading n by n upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading n by n lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J - COMPLEX AJJ -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL CSCAL, CTRMV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CTRTI2', -INFO ) - RETURN - END IF -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix. -* - DO 10 J = 1, N - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF -* -* Compute elements 1:j-1 of j-th column. -* - CALL CTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA, - $ A( 1, J ), 1 ) - CALL CSCAL( J-1, AJJ, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix. -* - DO 20 J = N, 1, -1 - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF - IF( J.LT.N ) THEN -* -* Compute elements j+1:n of j-th column. -* - CALL CTRMV( 'Lower', 'No transpose', DIAG, N-J, - $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) - CALL CSCAL( N-J, AJJ, A( J+1, J ), 1 ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of CTRTI2 -* - END diff --git a/testing/lin/ctrtri.f b/testing/lin/ctrtri.f deleted file mode 100644 index 04e1b7ab279a35b78f41fb1208d57404884bda70..0000000000000000000000000000000000000000 --- a/testing/lin/ctrtri.f +++ /dev/null @@ -1,215 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE CTRTRI( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* CTRTRI computes the inverse of a complex upper or lower triangular -* matrix A. -* -* This is the Level 3 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': A is upper triangular; -* = 'L': A is lower triangular. -* -* DIAG (input) CHARACTER*1 -* = 'N': A is non-unit triangular; -* = 'U': A is unit triangular. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading N-by-N upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading N-by-N lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, A(i,i) is exactly zero. The triangular -* matrix is singular and its inverse can not be computed. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX ONE, ZERO - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), - $ ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J, JB, NB, NN -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL CTRMM, CTRSM, CTRTI2, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CTRTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Check for singularity if non-unit. -* - IF( NOUNIT ) THEN - DO 10 INFO = 1, N - IF( A( INFO, INFO ).EQ.ZERO ) - $ RETURN - 10 CONTINUE - INFO = 0 - END IF -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'CTRTRI', UPLO // DIAG, N, -1, -1, -1 ) - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL CTRTI2( UPLO, DIAG, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix -* - DO 20 J = 1, N, NB - JB = MIN( NB, N-J+1 ) -* -* Compute rows 1:j-1 of current block column -* - CALL CTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, - $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL CTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, - $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) -* -* Compute inverse of current diagonal block -* - CALL CTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) - 20 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix -* - NN = ( ( N-1 ) / NB )*NB + 1 - DO 30 J = NN, 1, -NB - JB = MIN( NB, N-J+1 ) - IF( J+JB.LE.N ) THEN -* -* Compute rows j+jb:n of current block column -* - CALL CTRMM( 'Left', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, - $ A( J+JB, J ), LDA ) - CALL CTRSM( 'Right', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, - $ A( J+JB, J ), LDA ) - END IF -* -* Compute inverse of current diagonal block -* - CALL CTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) - 30 CONTINUE - END IF - END IF -* - RETURN -* -* End of CTRTRI -* - END diff --git a/testing/lin/dchkaa.f b/testing/lin/dchkaa.f deleted file mode 100644 index 1fb8892990535e1369b04aaf767391c69dee2443..0000000000000000000000000000000000000000 --- a/testing/lin/dchkaa.f +++ /dev/null @@ -1,638 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - PROGRAM DCHKAA -* - INCLUDE 'chameleon_fortran.h' -* -* -- CHAMELEON test routine (from LAPACK version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* Purpose -* ======= -* -* DCHKAA is the main test program for the DOUBLE PRECISION CHAMELEON -* linear equation routines -* -* The program must be driven by a short data file. The first 14 records -* specify problem dimensions and program options using list-directed -* input. The remaining lines specify the CHAMELEON test paths and the -* number of matrix types to use in testing. An annotated example of a -* data file can be obtained by deleting the first 3 characters from the -* following 36 lines: -* Data file for testing DOUBLE PRECISION CHAMELEON linear eqn. routines -* 1 Number of values of NP -* 16 Values of NP (number of cores) -* 1 Values of SCHED (0: STATIC, 1:DYNAMIC) -* 7 Number of values of M -* 0 1 2 3 5 10 16 Values of M (row dimension) -* 7 Number of values of N -* 0 1 2 3 5 10 16 Values of N (column dimension) -* 1 Number of values of NRHS -* 2 Values of NRHS (number of right hand sides) -* 5 Number of values of NB -* 1 3 3 3 20 Values of NB (the blocksize) -* 1 2 5 10 10 Values of IB (the inner block size) -* 1 0 5 9 1 Values of NX (crossover point) -* 3 Number of values of RANK -* 30 50 90 Values of rank (as a % of N) -* 20.0 Threshold value of test ratio -* T Put T to test the CHAMELEON routines -* T Put T to test the driver routines -* T Put T to test the error exits -* DGE 11 List types on next line if 0 < NTYPES < 11 -* DGB 8 List types on next line if 0 < NTYPES < 8 -* DGT 12 List types on next line if 0 < NTYPES < 12 -* DPO 9 List types on next line if 0 < NTYPES < 9 -* DPS 9 List types on next line if 0 < NTYPES < 9 -* DPP 9 List types on next line if 0 < NTYPES < 9 -* DPB 8 List types on next line if 0 < NTYPES < 8 -* DPT 12 List types on next line if 0 < NTYPES < 12 -* DSY 10 List types on next line if 0 < NTYPES < 10 -* DSP 10 List types on next line if 0 < NTYPES < 10 -* DTR 18 List types on next line if 0 < NTYPES < 18 -* DTP 18 List types on next line if 0 < NTYPES < 18 -* DTB 17 List types on next line if 0 < NTYPES < 17 -* DQR 8 List types on next line if 0 < NTYPES < 8 -* DRQ 8 List types on next line if 0 < NTYPES < 8 -* DLQ 8 List types on next line if 0 < NTYPES < 8 -* DQL 8 List types on next line if 0 < NTYPES < 8 -* DQP 6 List types on next line if 0 < NTYPES < 6 -* DTZ 3 List types on next line if 0 < NTYPES < 3 -* DLS 6 List types on next line if 0 < NTYPES < 6 -* DEQ -* -* Internal Parameters -* =================== -* -* NMAX INTEGER -* The maximum allowable value for N -* -* MAXIN INTEGER -* The number of different values that can be used for each of -* M, N, NRHS, NB, and NX -* -* MAXRHS INTEGER -* The maximum number of right hand sides -* -* NIN INTEGER -* The unit number for input -* -* NOUT INTEGER -* The unit number for output -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NPMAX - PARAMETER ( NPMAX = 16 ) - INTEGER NMAX - PARAMETER ( NMAX = 1000 ) - INTEGER MAXIN - PARAMETER ( MAXIN = 12 ) - INTEGER MAXRHS - PARAMETER ( MAXRHS = 16 ) - INTEGER MATMAX - PARAMETER ( MATMAX = 30 ) - INTEGER NIN, NOUT - PARAMETER ( NIN = 5, NOUT = 6 ) - INTEGER KDMAX - PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) -* .. -* .. Local Scalars .. - LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR - CHARACTER C1 - CHARACTER*2 C2 - CHARACTER*3 PATH - CHARACTER*10 INTSTR - CHARACTER*72 ALINE - INTEGER I, IB, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, - $ NN, NNB, NNB2, NNP, NNS, NP, SCHED, NRHS, - $ NTYPES, NRANK, VERS_MAJOR, VERS_MINOR, - $ VERS_PATCH, INFO - DOUBLE PRECISION EPS, S1, S2, THREQ, THRESH -* .. -* .. Local Arrays .. - LOGICAL DOTYPE( MATMAX ) - INTEGER IBVAL(MAXIN), IWORK( 25*NMAX ), MVAL( MAXIN ), - $ NBVAL( MAXIN ), NBVAL2( MAXIN ), - $ NPVAL( MAXIN), NSVAL( MAXIN ), - $ NVAL( MAXIN ), NXVAL( MAXIN ), - $ RANKVAL( MAXIN ), PIV( NMAX ) - DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), - $ RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ), - $ WORK( NMAX, NMAX+MAXRHS+30 ) -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - DOUBLE PRECISION DLAMCH, DSECND - EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND -* .. -* .. External Subroutines .. - EXTERNAL ALAREQ, DCHKGE, DCHKLQ, - $ DCHKPO, - $ DCHKQR, - $ DDRVGE, - $ DDRVLS, DDRVPO, - $ ILAVER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Arrays in Common .. - INTEGER IPARMS( 100 ) -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT - COMMON / CLAENV / IPARMS -* .. -* .. Data statements .. - DATA THREQ / 2.0D0 / , INTSTR / '0123456789' / -* .. -* .. Executable Statements .. -* -* S1 = DSECND( ) - LDA = NMAX - FATAL = .FALSE. -* -* Report values of parameters version. -* - CALL CHAMELEON_VERSION( VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO) - WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH -* -* Read a dummy line. -* - READ( NIN, FMT = * ) -* -* Read the values of NP -* - READ( NIN, FMT = * )NNP - IF( NNP.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNP ', NNP, 1 - NNP = 0 - FATAL = .TRUE. - ELSE IF( NNP.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNP ', NNP, MAXIN - NNP = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NPVAL( I ), I = 1, NNP ) - DO 01 I = 1, NNP - IF( NPVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NP ', NPVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NPVAL( I ).GT.NPMAX ) THEN - WRITE( NOUT, FMT = 9995 )' NP ', NPVAL( I ), NPMAX - FATAL = .TRUE. - END IF - 01 CONTINUE - IF( NNP.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NP ', ( NPVAL( I ), I = 1, NNP ) -* -* Read the values of SCHED -* - READ( NIN, FMT = * )SCHED - IF (( SCHED .LT. 0 ) .OR. (SCHED .GT. 1)) THEN - WRITE( NOUT, FMT = 9987 )' SCHED ', SCHED - SCHED = 0 - FATAL = .TRUE. - END IF -* -* Read the values of M -* - READ( NIN, FMT = * )NM - IF( NM.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 - NM = 0 - FATAL = .TRUE. - ELSE IF( NM.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN - NM = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) - DO 10 I = 1, NM - IF( MVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( MVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX - FATAL = .TRUE. - END IF - 10 CONTINUE - IF( NM.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) -* -* Read the values of N -* - READ( NIN, FMT = * )NN - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 - NN = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN - NN = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) - DO 20 I = 1, NN - IF( NVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX - FATAL = .TRUE. - END IF - 20 CONTINUE - IF( NN.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) -* -* Read the values of NRHS -* - READ( NIN, FMT = * )NNS - IF( NNS.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 - NNS = 0 - FATAL = .TRUE. - ELSE IF( NNS.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN - NNS = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) - DO 30 I = 1, NNS - IF( NSVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN - WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS - FATAL = .TRUE. - END IF - 30 CONTINUE - IF( NNS.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) -* -* Read the values of NB -* - READ( NIN, FMT = * )NNB - IF( NNB.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 - NNB = 0 - FATAL = .TRUE. - ELSE IF( NNB.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN - NNB = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) - DO 40 I = 1, NNB - IF( NBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 - FATAL = .TRUE. - END IF - 40 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) -* -* Read the values of IB -* - READ( NIN, FMT = * )( IBVAL( I ), I = 1, NNB ) - DO 41 I = 1, NNB - IF( IBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', IBVAL( I ), 0 - FATAL = .TRUE. - END IF - 41 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'IB ', ( IBVAL( I ), I = 1, NNB ) -* -* Set NBVAL2 to be the set of unique values of NB -* - NNB2 = 0 - DO 60 I = 1, NNB - NB = NBVAL( I ) - DO 50 J = 1, NNB2 - IF( NB.EQ.NBVAL2( J ) ) - $ GO TO 60 - 50 CONTINUE - NNB2 = NNB2 + 1 - NBVAL2( NNB2 ) = NB - 60 CONTINUE -* -* Read the values of NX -* - READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) - DO 70 I = 1, NNB - IF( NXVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 - FATAL = .TRUE. - END IF - 70 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) -* -* Read the values of RANKVAL -* - READ( NIN, FMT = * )NRANK - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 - NRANK = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN - NRANK = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) - DO I = 1, NRANK - IF( RANKVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( RANKVAL( I ).GT.100 ) THEN - WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 - FATAL = .TRUE. - END IF - END DO - IF( NRANK.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', - $ ( RANKVAL( I ), I = 1, NRANK ) -* -* Read the threshold value for the test ratios. -* - READ( NIN, FMT = * )THRESH - WRITE( NOUT, FMT = 9992 )THRESH -* -* Read the flag that indicates whether to test the CHAMELEON routines. -* - READ( NIN, FMT = * )TSTCHK -* -* Read the flag that indicates whether to test the driver routines. -* - READ( NIN, FMT = * )TSTDRV -* -* Read the flag that indicates whether to test the error exits. -* - READ( NIN, FMT = * )TSTERR -* - IF( FATAL ) THEN - WRITE( NOUT, FMT = 9999 ) - STOP - END IF -* -* Calculate and print the machine dependent constants. -* - EPS = DLAMCH( 'Underflow threshold' ) - WRITE( NOUT, FMT = 9991 )'underflow', EPS - EPS = DLAMCH( 'Overflow threshold' ) - WRITE( NOUT, FMT = 9991 )'overflow ', EPS - EPS = DLAMCH( 'Epsilon' ) - WRITE( NOUT, FMT = 9991 )'precision', EPS - WRITE( NOUT, FMT = * ) -* -* Initialize CHAMELEON -* - CALL CHAMELEON_INIT( NPVAL(NNP), INFO ) -* - IF( SCHED .EQ. 1 ) THEN - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_DYNAMIC_SCHEDULING, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_STATIC_SCHEDULING, INFO ) - ENDIF -* - CALL CHAMELEON_DISABLE( CHAMELEON_AUTOTUNING, INFO ) -* -* - 80 CONTINUE -* -* Read a test path and the number of matrix types to use. -* - READ( NIN, FMT = '(A72)', END = 140 )ALINE - PATH = ALINE( 1: 3 ) - NMATS = MATMAX - I = 3 - 90 CONTINUE - I = I + 1 - IF( I.GT.72 ) THEN - NMATS = MATMAX - GO TO 130 - END IF - IF( ALINE( I: I ).EQ.' ' ) - $ GO TO 90 - NMATS = 0 - 100 CONTINUE - C1 = ALINE( I: I ) - DO 110 K = 1, 10 - IF( C1.EQ.INTSTR( K: K ) ) THEN - IC = K - 1 - GO TO 120 - END IF - 110 CONTINUE - GO TO 130 - 120 CONTINUE - NMATS = NMATS*10 + IC - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - GO TO 100 - 130 CONTINUE - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - NRHS = NSVAL( 1 ) -* -* Check first character for correct precision. -* - IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN - WRITE( NOUT, FMT = 9990 )PATH -* - ELSE IF( NMATS.LE.0 ) THEN -* -* Check for a positive number of tests requested. -* - WRITE( NOUT, FMT = 9989 )PATH -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* GE: general matrices -* - NTYPES = 11 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), - $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* PO: positive definite matrices -* - NTYPES = 9 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL DCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, - $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), - $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN -* -* QR: QR factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN -* -* LQ: LQ factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* LS: Least squares drivers -* - NTYPES = 6 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTDRV ) THEN - CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), - $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ RWORK, RWORK( NMAX+1 ), IBVAL, WORK, IWORK, - $ NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE -* - WRITE( NOUT, FMT = 9990 )PATH - END IF -* -* Go back to get another input line. -* - GO TO 80 -* -* Branch to this line when the last record is read. -* - 140 CONTINUE - CLOSE ( NIN ) -* -* Finalize CHAMELEON -* - CALL CHAMELEON_FINALIZE( INFO ) -* -* S2 = DSECND( ) - WRITE( NOUT, FMT = 9998 ) -* WRITE( NOUT, FMT = 9997 )S2 - S1 -* - 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / ' End of tests' ) - 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) - 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', - $ I6 ) - 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', - $ I6 ) - 9994 FORMAT( ' Tests of the DOUBLE PRECISION CHAMELEON routines ', - $ / ' CHAMELEON VERSION ', I1, '.', I1, '.', I1, - $ / / ' The following parameter values will be used:' ) - 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) - 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', - $ 'less than', F8.2, / ) - 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) - 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) - 9989 FORMAT( / 1X, A3, ' routines were not tested' ) - 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) - 9987 FORMAT( ' Invalid input value: ', A6, '=', I6, '; must be 0 or 1') -* -* End of DCHKAA -* - END diff --git a/testing/lin/dchkge.f b/testing/lin/dchkge.f deleted file mode 100644 index 78540b97579763c0768940a438c28eed72f82056..0000000000000000000000000000000000000000 --- a/testing/lin/dchkge.f +++ /dev/null @@ -1,449 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, - $ AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IBVAL( * ), IWORK( * ), MVAL( * ), NBVAL( * ), - $ NSVAL( * ), NVAL( * ) - DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ), - $ RWORK( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DCHKGE tests DGETRF, -TRI, -TRS, -RFS, and -CON. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the tile size NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AFAC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AINV (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension -* (max(2*NMAX,2*NSMAX+NWORK)) -* -* IWORK (workspace) INTEGER array, dimension (2*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* ONLY NOTRANS SUPPORTED !!! - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL TRFCON, ZEROT - CHARACTER DIST, NORM, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IM, IMAT, IB, IN, INB, INFO, IOFF, IRHS, - $ ITRAN, IZERO, K, KL, KU, LDA, LWORK, M, MODE, - $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT - DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY, - $ RCOND, RCONDC, RCONDI, RCONDO - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER CHAMELEON_TRANS -* .. -* .. Local Arrays .. - CHARACTER TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DGET06, DLANGE - EXTERNAL DGET06, DLANGE -* .. -* .. External Subroutines .. -*** EXTERNAL ALAERH, ALAHD, ALASUM, DERRGE, DGECON, DGERFS, -*** $ DGET01 , DGET02, DGET03, DGET04, DGET07, DGETRF, -*** $ DGETRI, DGETRS, DLACPY, DLARHS, DLASET, DLATB4, -*** $ DLATMS, DERRGEX, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / , -* $ TRANSS / 'N', 'T', 'C' / - $ TRANSS / 'N' /, - $ CHAMELEON_TRANSS / CHAMELEONNOTRANS / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - CALL XLAENV( 1, 1 ) - IF( TSTERR ) - $ CALL DERRGE( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of M in MVAL -* - DO 120 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* -* Do for each value of N in NVAL -* - DO 110 IN = 1, NN - N = NVAL( IN ) - XTYPE = 'N' - NIMAT = NTYPES - IF( M.LE.0 .OR. N.LE.0 ) - $ NIMAT = 1 -* - DO 100 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 100 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 100 -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'DLATMS' - CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = MIN( M, N ) - ELSE - IZERO = MIN( M, N ) / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, M - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL DLASET( 'Full', M, N-IZERO+1, ZERO, ZERO, - $ A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Do for each blocksize in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* ALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_DGETRF_INCPIV( -c$$$ $ M, N, HL, HPIV, INFO ) -* -* Compute the LU factorization of the matrix. -* - CALL DLACPY( 'Full', M, N, A, LDA, AFAC, LDA ) - SRNAMT = 'DGETRF' -c$$$ CALL CHAMELEON_DGETRF_INCPIV( M, N, AFAC, LDA, HL, HPIV, -c$$$ $ INFO ) - CALL CHAMELEON_DGETRF( M, N, AFAC, LDA, IWORK, - $ INFO ) -* -* Check error code from DGETRF. -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'DGETRF', INFO, IZERO, ' ', M, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - TRFCON = .FALSE. - NT = 0 -* - IF( M.NE.N .OR. INFO.GT.0 ) THEN -* -* Do only the condition estimate if INFO > 0. -* - TRFCON = .TRUE. - ANORMO = DLANGE( 'O', M, N, A, LDA, RWORK ) - ANORMI = DLANGE( 'I', M, N, A, LDA, RWORK ) - RCONDO = ZERO - RCONDI = ZERO - END IF -* -* Print information about the tests so far that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT -* -* Skip the remaining tests if this is not the first -* block size or if M .ne. N. Skip the solve tests if -* the matrix is singular. -* -* IF( INB.GT.1 .OR. M.NE.N ) -* $ GO TO 90 - IF( TRFCON ) - $ GO TO 70 -* - DO 60 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) - XTYPE = 'N' -* - DO 50 ITRAN = 1, NTRAN - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -*+ TEST 3 -* Solve and compute residual for A * X = B. -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, - $ LDA, ISEED, INFO ) - XTYPE = 'C' -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) - SRNAMT = 'DGETRS' -c$$$ CALL CHAMELEON_DGETRS_INCPIV( CHAMELEON_TRANS, N, -c$$$ $ NRHS, AFAC, LDA, HL, HPIV, -c$$$ $ X, LDA, INFO ) - CALL CHAMELEON_DGETRS( CHAMELEON_TRANS, N, - $ NRHS, AFAC, LDA, IWORK, - $ X, LDA, INFO ) -* -* Check error code from DGETRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DGETRS', INFO, 0, TRANS, - $ N, N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL DGET02( TRANS, N, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 3 ) ) - -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -* Print information about the tests that did not -* pass the threshold. -* - DO 40 K = 3, 4 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )TRANS, N, NB, - $ NRHS, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 40 CONTINUE - NRUN = NRUN + 2 - 50 CONTINUE - 60 CONTINUE -* - 70 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M = ', I5, ', N =', I5, ', NB =', I4, ', type ', I2, - $ ', test(', I2, ') =', G12.5 ) - 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NB =', I4 ,', - $ NRHS=', I3, ',type ', I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of DCHKGE -* - END diff --git a/testing/lin/dchklq.f b/testing/lin/dchklq.f deleted file mode 100644 index d40ccd767b013f0b311cc9ce0dcb820d3f5b27e9..0000000000000000000000000000000000000000 --- a/testing/lin/dchklq.f +++ /dev/null @@ -1,420 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AL, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), - $ B( * ), RWORK( * ), TAU( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DCHKLQ tests DGELQF, DORGLQ and DORMLQ. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AQ (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AL (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* TAU (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - DOUBLE PRECISION ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL DGENND - EXTERNAL DGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGET02, - $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02, - $ DLQT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'LQ' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL DERRLQ( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( N.LT.M ) - $ GO TO 60 - MINMN = MIN( M, N ) -* - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'DLATMS' - CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of DLQT01; other values are -* used in the calls of DLQT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGELQF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test DGELQF -* - CALL DLQT01( M, N, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.DGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.LE.N ) THEN -* -* Test DORGLQ, using factorization -* returned by DLQT01 -* - CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - ELSE - RESULT( 1 ) = ZERO - RESULT( 2 ) = ZERO - END IF - IF( M.GE.K ) THEN -* -* Test DORMLQ, using factorization returned -* by DLQT01 -* - CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call DGELQS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.M .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL DLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'DGELQS' - CALL CHAMELEON_DGELQS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from DGELQS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DGELQS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL DGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - ELSE - RESULT( 7 ) = ZERO - END IF - ELSE - RESULT( 3 ) = ZERO - RESULT( 4 ) = ZERO - RESULT( 5 ) = ZERO - RESULT( 6 ) = ZERO - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NT - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, IB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE -* - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', IB=', - $ I4, ', NX=', I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of DCHKLQ -* - END diff --git a/testing/lin/dchkpo.f b/testing/lin/dchkpo.f deleted file mode 100644 index 4c3af1a48fae566fb221ee85fc4f3c94317285ea..0000000000000000000000000000000000000000 --- a/testing/lin/dchkpo.f +++ /dev/null @@ -1,478 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, - $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, - $ XACT, WORK, RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) - DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ), - $ RWORK( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DCHKPO tests DPOTRF, -TRI, -TRS, -RFS, and -CON -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AFAC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AINV (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NSMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension -* (max(NMAX,2*NSMAX)) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* .. -* .. Local Scalars .. - LOGICAL ZEROT - CHARACTER DIST, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO, - $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS, - $ NFAIL, NIMAT, NRHS, NRUN - INTEGER CHAMELEON_UPLO - DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC -* .. -* .. Local Arrays .. - CHARACTER UPLOS( 2 ) - INTEGER CHAMELEON_UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DGET06, DLANSY - EXTERNAL DGET06, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRPO, DGET04, DLACPY, - $ DLARHS, DLATB4, DLATMS, DPOCON, DPORFS, DPOT01, - $ DPOT02, DPOT03, DPOT05,DPOTRF, DPOTRI, DPOTRS, - $ XLAENV -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL DERRPO( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of N in NVAL -* - DO 120 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - IZERO = 0 - DO 110 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 110 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 110 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 100 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'DLATMS' - CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Do for each value of NB in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (N / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Compute the L*L' or U'*U factorization of the matrix. -* - CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - SRNAMT = 'DPOTRF' - CALL CHAMELEON_DPOTRF( CHAMELEON_UPLO, N, AFAC, LDA, INFO ) -* -* Check error code from DPOTRF. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'DPOTRF', INFO, IZERO, UPLO, N, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - GO TO 90 - END IF -* -* Skip the tests if INFO is not 0. -* - IF( INFO.NE.0 ) - $ GO TO 90 -* -*+ TEST 1 -* Reconstruct matrix from factors and compute residual. -* - CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - CALL DPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK, - $ RESULT( 1 ) ) -* -*+ TEST 2 -* Form the inverse and compute the residual. -* - CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - SRNAMT = 'DPOTRI' - CALL CHAMELEON_DPOTRI( CHAMELEON_UPLO, N, AINV, LDA, - $ INFO ) -* -* Check error code from DPOTRI. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DPOTRI', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - CALL DPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, - $ RWORK, RCONDC, RESULT( 2 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 60 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + 2 -* -* Skip the rest of the tests unless this is the first -* blocksize. -* - IF( INB.NE.1 ) - $ GO TO 90 -* - DO 80 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) -* -*+ TEST 3 -* Solve and compute residual for A * X = B . -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'DPOTRS' - CALL CHAMELEON_DPOTRS( CHAMELEON_UPLO, N, NRHS, AFAC, - $ LDA, X, LDA, INFO ) -* -* -* Check error code from DPOTRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DPOTRS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) - CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 3 ) ) -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -*+ TESTS 5, 6, and 7 -* Use iterative refinement to improve the solution. -* - SRNAMT = 'DPORFS' - CALL DPORFS( UPLO, N, NRHS, A, LDA, - $ AFAC, LDA, B, LDA, X, LDA, - $ RWORK, RWORK( NRHS+1 ), WORK, IWORK, - $ INFO ) -* -* Check error code from DPORFS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DPORFS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 5 ) ) - CALL DPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, - $ XACT, LDA, RWORK, RWORK( NRHS+1 ), - $ RESULT( 6 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 70 K = 3, 7 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 70 CONTINUE - NRUN = NRUN + 5 - 80 CONTINUE -* -*+ TEST 8 -* Get an estimate of RCOND = 1/CNDNUM. -* - ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) - SRNAMT = 'DPOCON' - CALL DPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK, - $ IWORK, INFO ) -* -* Check error code from DPOCON. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DPOCON', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - RESULT( 8 ) = DGET06( RCOND, RCONDC ) -* -* Print the test ratio if it is .GE. THRESH. -* - IF( RESULT( 8 ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8, - $ RESULT( 8 ) - NFAIL = NFAIL + 1 - END IF - NRUN = NRUN + 1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', - $ I2, ', test ', I2, ', ratio =', G12.5 ) - 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of DCHKPO -* - END diff --git a/testing/lin/dchkqr.f b/testing/lin/dchkqr.f deleted file mode 100644 index dbd56936b68f39b4989c1c65146d3a1fd934694c..0000000000000000000000000000000000000000 --- a/testing/lin/dchkqr.f +++ /dev/null @@ -1,409 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IBVAL( * ), IWORK( * ), MVAL( * ), NBVAL( * ), - $ NVAL( * ), NXVAL( * ) - DOUBLE PRECISION A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), - $ B( * ), RWORK( * ), TAU( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DCHKQR tests DGEQRF, DORGQR and DORMQR. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AQ (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AR (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* TAU (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IB, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, - $ LDA, LWORK, M, MINMN, MODE, N, NB, NERRS, - $ NFAIL, NK, NRUN, NT, NX, IRH, RHBLK - DOUBLE PRECISION ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL DGENND - EXTERNAL DGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGET02, - $ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01, DQRT02, - $ DQRT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'QR' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL DERRQR( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( M.LT.N ) - $ GO TO 60 - MINMN = MIN( M, N ) -* - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'DLATMS' - CALL DLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of DQRT01; other values are -* used in the calls of DQRT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGEQRF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test DGEQRF -* - CALL DQRT01( M, N, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.DGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.GE.N ) THEN -* -* Test DORGQR, using factorization -* returned by DQRT01 - - CALL DQRT02( M, N, K, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - END IF - IF( M.GE.K ) THEN -* -* Test DORMQR, using factorization returned -* by DQRT01 -* - CALL DQRT03( M, N, K, AF, AC, AR, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call DGEQRS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.N .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL DLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'DGEQRS' - CALL CHAMELEON_DGEQRS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) - -* Check error code from DGEQRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DGEQRS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL DGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - END IF - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NT - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, IB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', IB=', - $ I4, ', NX=', I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of DCHKQR -* - END diff --git a/testing/lin/ddrvge.f b/testing/lin/ddrvge.f deleted file mode 100644 index fe7d2787f0611f854692d405ce65a753a49dcda2..0000000000000000000000000000000000000000 --- a/testing/lin/ddrvge.f +++ /dev/null @@ -1,470 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - DOUBLE PRECISION A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DDRVGE tests the driver routines DGESV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AFAC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* ASAV (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* BSAV (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* S (workspace) DOUBLE PRECISION array, dimension (2*NMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (2*NRHS+NMAX) -* -* IWORK (workspace) INTEGER array, dimension (2*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) -* ONLY NOTRANS SUPPORTED !!! - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT - CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, - $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, - $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, IB - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER CHAMELEON_TRANS - DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, - $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, - $ ROLDI, ROLDO, ROWCND, RPVGRW -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DGET06, DLAMCH, DLANGE, DLANTR - EXTERNAL LSAME, DGET06, DLAMCH, DLANGE, DLANTR -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, DGEEQU, DGESV, - $ DGESVX, DGET02, DGET04, DGETRF, - $ DGETRI, DLACPY, DLAQGE, DLARHS, DLASET, DLATB4, - $ DLATMS, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* DATA TRANSS / 'N', 'T', 'C' / - DATA TRANSS / 'N' / - DATA CHAMELEON_TRANSS / CHAMELEONNOTRANS / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'R', 'C', 'B' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL DERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - IB = 32 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* Do for each value of N in NVAL -* - DO 90 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* -* ALLOCATE L and IPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_DGETRF_INCPIV( -c$$$ $ N, N, HL, HPIV, INFO ) -* - DO 80 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 80 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 80 -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) - RCONDC = ONE / CNDNUM -* - SRNAMT = 'DLATMS' - CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, - $ ANORM, KL, KU, 'No packing', A, LDA, WORK, - $ INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, ' ', N, N, -1, -1, - $ -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 80 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, N - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL DLASET( 'Full', N, N-IZERO+1, ZERO, ZERO, - $ A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL DLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) -* - DO 70 IEQUED = 1, 4 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 60 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 60 - RCONDO = ZERO - RCONDI = ZERO -* - ELSE IF( .NOT.NOFACT ) THEN -* -* Compute the condition number for comparison with -* the value returned by DGESVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL DLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL DGEEQU( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( LSAME( EQUED, 'R' ) ) THEN - ROWCND = ZERO - COLCND = ONE - ELSE IF( LSAME( EQUED, 'C' ) ) THEN - ROWCND = ONE - COLCND = ZERO - ELSE IF( LSAME( EQUED, 'B' ) ) THEN - ROWCND = ZERO - COLCND = ZERO - END IF -* -* Equilibrate the matrix. -* - CALL DLAQGE( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the non-equilibrated -* system for use in DGET04. -* - IF( EQUIL ) THEN - ROLDO = RCONDO - ROLDI = RCONDI - END IF -* -* Compute the 1-norm and infinity-norm of A. -* - ANORMO = DLANGE( '1', N, N, AFAC, LDA, RWORK ) - ANORMI = DLANGE( 'I', N, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* -c$$$ CALL CHAMELEON_DGETRF_INCPIV( N, N, AFAC, LDA, -c$$$ $ HL, HPIV, INFO ) - CALL CHAMELEON_DGETRF( N, N, AFAC, LDA, - $ IWORK, INFO ) - END IF -* - DO 50 ITRAN = 1, NTRAN -* -* Do for each value of TRANS. -* - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -* Restore the matrix A. -* - CALL DLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL DLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT .AND. ITRAN.EQ.1 ) THEN -* -* --- Test DGESV --- -* -* Compute the LU factorization of the matrix and -* solve the system. -* - CALL DLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) - CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'DGESV ' -c$$$ CALL CHAMELEON_DGESV_INCPIV( N, NRHS, AFAC, LDA, -c$$$ $ HL, HPIV, X, LDA, INFO ) - CALL CHAMELEON_DGESV( N, NRHS, AFAC, LDA, - $ IWORK, X, LDA, INFO ) -* -* Check error code from DGESV . -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'DGESV ', INFO, IZERO, - $ ' ', N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - IF( IZERO.EQ.0 ) THEN -* -* Compute residual of the computed solution. -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL DGET02( 'No transpose', N, N, NRHS, A, - $ LDA, X, LDA, WORK, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Check solution from generated exact solution. -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 2 ) ) - NT = 2 - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'DGESV ', N, IB, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT - END IF - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', N =', I5,', NB=', I5, ', type ', I2, - $ ', test(', I2, ') =', G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', type ', I2, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', - $ G12.5 ) - RETURN -* -* End of DDRVGE -* - END diff --git a/testing/lin/ddrvls.f b/testing/lin/ddrvls.f deleted file mode 100644 index 389acdc2b12bd8691c56aa63e67c3e11453f3e9b..0000000000000000000000000000000000000000 --- a/testing/lin/ddrvls.f +++ /dev/null @@ -1,408 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, IBVAL, WORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ NVAL( * ), NXVAL( * ), IBVAL ( * ) - DOUBLE PRECISION A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ COPYS( * ), S( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* DDRVLS tests the least squares driver routines DGELS, DGELSS, DGELSX, -* DGELSY and DGELSD. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* The matrix of type j is generated as follows: -* j=1: A = U*D*V where U and V are random orthogonal matrices -* and D has random entries (> 0.1) taken from a uniform -* distribution (0,1). A is full rank. -* j=2: The same of 1, but A is scaled up. -* j=3: The same of 1, but A is scaled down. -* j=4: A = U*D*V where U and V are random orthogonal matrices -* and D has 3*min(M,N)/4 random entries (> 0.1) taken -* from a uniform distribution (0,1) and the remaining -* entries set to 0. A is rank-deficient. -* j=5: The same of 4, but A is scaled up. -* j=6: The same of 5, but A is scaled down. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the tile size NB. -* -* IBVAL (input) INTEGER array, dimension (NNB) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* A (workspace) DOUBLE PRECISION array, dimension (MMAX*NMAX) -* where MMAX is the maximum value of M in MVAL and NMAX is the -* maximum value of N in NVAL. -* -* COPYA (workspace) DOUBLE PRECISION array, dimension (MMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (MMAX*NSMAX) -* where MMAX is the maximum value of M in MVAL and NSMAX is the -* maximum value of NRHS in NSVAL. -* -* COPYB (workspace) DOUBLE PRECISION array, dimension (MMAX*NSMAX) -* -* C (workspace) DOUBLE PRECISION array, dimension (MMAX*NSMAX) -* -* S (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* -* WORK (workspace) DOUBLE PRECISION array, -* dimension (MMAX*NMAX + 4*NMAX + MMAX). -* -* IWORK (workspace) INTEGER array, dimension (15*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 18 ) - INTEGER SMLSIZ - PARAMETER ( SMLSIZ = 25 ) - DOUBLE PRECISION ONE, TWO, ZERO - PARAMETER ( ONE = 1.0D0, TWO = 2.0D0, ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - CHARACTER TRANS - CHARACTER*3 PATH - INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, IB, NCOLS, - $ NERRS, NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, - $ CHAMELEON_TRANS - INTEGER HT( 2 ) - DOUBLE PRECISION EPS, NORMA, NORMB, RCOND -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, DQRT14, DQRT17 - EXTERNAL DASUM, DLAMCH, DQRT14, DQRT17 -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASVM, DAXPY, DERRLS, DGELS, - $ DGELSD, DGELSS, DGELSX, DGELSY, DGEMM, DLACPY, - $ DLARNV, DLASRT, DQRT13, DQRT15, DQRT16, DSCAL, - $ XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, INT, LOG, MAX, MIN, SQRT -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, IOUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, IOUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'LS' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE - EPS = DLAMCH( 'Epsilon' ) -* -* Threshold for rank estimation -* - RCOND = SQRT( EPS ) - ( SQRT( EPS )-EPS ) / 2 -* -* Test the error exits -* - CALL XLAENV( 2, 2 ) - CALL XLAENV( 9, SMLSIZ ) - IF( TSTERR ) - $ CALL DERRLS( PATH, NOUT ) -* -* Print the header if NM = 0 or NN = 0 and THRESH = 0. -* - IF( ( NM.EQ.0 .OR. NN.EQ.0 ) .AND. THRESH.EQ.ZERO ) - $ CALL ALAHD( NOUT, PATH ) - INFOT = 0 - CALL XLAENV( 2, 2 ) - CALL XLAENV( 9, SMLSIZ ) -* - DO 150 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* - DO 140 IN = 1, NN - N = NVAL( IN ) - MNMIN = MIN( M, N ) - LDB = MAX( 1, M, N ) -* - DO 130 INS = 1, NNS - NRHS = NSVAL( INS ) - NLVL = MAX( INT( LOG( MAX( ONE, DBLE( MNMIN ) ) / - $ DBLE( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1, 0 ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ - $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2 ) -* - DO 120 IRANK = 1, 2 - DO 110 ISCALE = 1, 3 - ITYPE = ( IRANK-1 )*3 + ISCALE - IF( .NOT.DOTYPE( ITYPE ) ) - $ GO TO 110 -* - IF( IRANK.EQ.1 ) THEN -* -* Test DGELS -* -* Generate a matrix of scaling type ISCALE -* - CALL DQRT13( ISCALE, M, N, COPYA, LDA, NORMA, - $ ISEED ) - DO 40 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - CALL XLAENV( 3, NXVAL( INB ) ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 40 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, - $ INFO ) -* -* Allocate T -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGELS( M, N , HT, - $ INFO ) -* -* DO 30 ITRAN = 1, 2 - DO 30 ITRAN = 1, 1 -* -* ONLY CHAMELEONNOTRANS supported ! -* - IF( ITRAN.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - NROWS = M - NCOLS = N - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - NROWS = N - NCOLS = M - END IF - LDWORK = MAX( 1, NCOLS ) -* -* Set up a consistent rhs -* - IF( NCOLS.GT.0 ) THEN - CALL DLARNV( 2, ISEED, NCOLS*NRHS, - $ WORK ) - CALL DSCAL( NCOLS*NRHS, - $ ONE / DBLE( NCOLS ), WORK, - $ 1 ) - END IF - CALL DGEMM( TRANS, 'No transpose', NROWS, - $ NRHS, NCOLS, ONE, COPYA, LDA, - $ WORK, LDWORK, ZERO, B, LDB ) - CALL DLACPY( 'Full', NROWS, NRHS, B, LDB, - $ COPYB, LDB ) -* -* Solve LS or overdetermined system -* - IF( M.GT.0 .AND. N.GT.0 ) THEN - CALL DLACPY( 'Full', M, N, COPYA, LDA, - $ A, LDA ) - CALL DLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, B, LDB ) - END IF - SRNAMT = 'DGELS ' -* - CALL CHAMELEON_DGELS( CHAMELEON_TRANS, - $ M, N, NRHS, - $ A, LDA, HT, B, LDB, - $ INFO ) -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'DGELS ', INFO, 0, - $ TRANS, M, N, NRHS, -1, NB, - $ ITYPE, NFAIL, NERRS, - $ NOUT ) -* -* Check correctness of results -* - LDWORK = MAX( 1, NROWS ) - IF( NROWS.GT.0 .AND. NRHS.GT.0 ) - $ CALL DLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, C, LDB ) - CALL DQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, WORK, - $ RESULT( 1 ) ) -* - IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. - $ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN -* -* Solving LS system -* - RESULT( 2 ) = DQRT17( TRANS, 1, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ COPYB, LDB, C, WORK, - $ LWORK ) - ELSE -* -* Solving overdetermined system -* - RESULT( 2 ) = DQRT14( TRANS, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ WORK, LWORK ) - END IF -* -* Print information about the tests that -* did not pass the threshold. -* - DO 20 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )TRANS, M, - $ N, NRHS, NB, ITYPE, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + 2 - 30 CONTINUE -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 40 CONTINUE - END IF -* - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - 150 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) - 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, - $ ', type', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of DDRVLS -* - END diff --git a/testing/lin/ddrvpo.f b/testing/lin/ddrvpo.f deleted file mode 100644 index 787231fda06ca048e3e1723a3377bb607ceaef5d..0000000000000000000000000000000000000000 --- a/testing/lin/ddrvpo.f +++ /dev/null @@ -1,563 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - DOUBLE PRECISION A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* DDRVPO tests the driver routines DPOSV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* AFAC (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* ASAV (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX) -* -* B (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* BSAV (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* X (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* XACT (workspace) DOUBLE PRECISION array, dimension (NMAX*NRHS) -* -* S (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* WORK (workspace) DOUBLE PRECISION array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 6 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, ZEROT - CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, - $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, - $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, - $ CHAMELEON_UPLO - DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, - $ ROLDC, SCOND -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_UPLOS( 2 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DGET06, DLANSY - EXTERNAL LSAME, DGET06, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY, - $ DLAQSY, DLARHS, DLASET, DLATB4, DLATMS, DPOEQU, - $ DPOSV, DPOSVX, DPOT01, DPOT02, DPOT05, DPOTRF, - $ DPOTRI, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'Y' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Double precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL DERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Do for each value of N in NVAL -* - DO 130 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - DO 120 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 120 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 120 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 110 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with DLATB4 and generate a test matrix -* with DLATMS. -* - CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'DLATMS' - CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from DLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 110 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL DLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) -* - DO 100 IEQUED = 1, 2 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 90 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 90 - RCONDC = ZERO -* - ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN -* -* Compute the condition number for comparison with -* the value returned by DPOSVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL DLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL DPOEQU( N, AFAC, LDA, S, SCOND, AMAX, - $ INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( IEQUED.GT.1 ) - $ SCOND = ZERO -* -* Equilibrate the matrix. -* - CALL DLAQSY( UPLO, N, AFAC, LDA, S, SCOND, - $ AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the -* non-equilibrated system for use in DGET04. -* - IF( EQUIL ) - $ ROLDC = RCONDC -* -* Compute the 1-norm of A. -* - ANORM = DLANSY( '1', UPLO, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* - CALL CHAMELEON_DPOTRF( CHAMELEON_UPLO, N, - $ AFAC, LDA, INFO ) -* -* Form the inverse of A. -* - CALL DLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) - CALL CHAMELEON_DPOTRI( CHAMELEON_UPLO, N, A, LDA, - $ INFO ) -* -* Compute the 1-norm condition number of A. -* - AINVNM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCONDC = ONE - ELSE - RCONDC = ( ONE / ANORM ) / AINVNM - END IF - END IF -* -* Restore the matrix A. -* - CALL DLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'DLARHS' - CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL DLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT ) THEN -* -* --- Test DPOSV --- -* -* Compute the L*L' or U'*U factorization of the -* matrix and solve the system. -* - CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'DPOSV ' - CALL CHAMELEON_DPOSV( CHAMELEON_UPLO, N, NRHS, - $ AFAC, LDA, X, LDA, INFO ) -* -* Check error code from DPOSV . -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'DPOSV ', INFO, IZERO, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - GO TO 70 - ELSE IF( INFO.NE.0 ) THEN - GO TO 70 - END IF -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Compute residual of the computed solution. -* - CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 -* -* Print information about the tests that did not -* pass the threshold. -* - DO 60 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'DPOSV ', UPLO, - $ N, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + NT - 70 CONTINUE - END IF -* -* --- Test DPOSVX --- -* - IF( .NOT.PREFAC ) - $ CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) - CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) - IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN -* -* Equilibrate the matrix if FACT='F' and -* EQUED='Y'. -* - CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, - $ EQUED ) - END IF -* -* Solve the system and compute the condition number -* and error bounds using DPOSVX. -* - SRNAMT = 'DPOSVX' - CALL DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, - $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, - $ RWORK, RWORK( NRHS+1 ), WORK, IWORK, - $ INFO ) -* -* Check the error code from DPOSVX. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'DPOSVX', INFO, IZERO, - $ FACT // UPLO, N, N, -1, -1, NRHS, - $ IMAT, NFAIL, NERRS, NOUT ) - GO TO 90 - END IF - - IF( INFO.EQ.0 ) THEN - IF( .NOT.PREFAC ) THEN -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, - $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) - K1 = 1 - ELSE - K1 = 2 - END IF -* -* Compute residual of the computed solution. -* - CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, - $ LDA ) - CALL DPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, - $ WORK, LDA, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, - $ 'N' ) ) ) THEN - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 3 ) ) - ELSE - CALL DGET04( N, NRHS, X, LDA, XACT, LDA, - $ ROLDC, RESULT( 3 ) ) - END IF -* -* Check the error bounds from iterative -* refinement. -* - CALL DPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, - $ X, LDA, XACT, LDA, RWORK, - $ RWORK( NRHS+1 ), RESULT( 4 ) ) - ELSE - K1 = 6 - END IF -* -* Compare RCOND from DPOSVX with the computed value -* in RCONDC. -* - RESULT( 6 ) = DGET06( RCOND, RCONDC ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 80 K = K1, 6 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - IF( PREFAC ) THEN - WRITE( NOUT, FMT = 9997 )'DPOSVX', FACT, - $ UPLO, N, EQUED, IMAT, K, RESULT( K ) - ELSE - WRITE( NOUT, FMT = 9998 )'DPOSVX', FACT, - $ UPLO, N, IMAT, K, RESULT( K ) - END IF - NFAIL = NFAIL + 1 - END IF - 80 CONTINUE - NRUN = NRUN + 7 - K1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, - $ ', test(', I1, ')=', G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', type ', I1, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', - $ G12.5 ) - RETURN -* -* End of DDRVPO -* - END diff --git a/testing/lin/derrge.f b/testing/lin/derrge.f deleted file mode 100644 index 179b985f61a46691795f60f0d18ddb8ac406d9a3..0000000000000000000000000000000000000000 --- a/testing/lin/derrge.f +++ /dev/null @@ -1,237 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRGE( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRGE tests the error exits for the DOUBLE PRECISION routines -* for general matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX, LW - PARAMETER ( NMAX = 4, LW = 3*NMAX ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION ANRM, CCOND, RCOND -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ), IW( NMAX ) - INTEGER HL( 2 ), HPIV( 2 ) - DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, - $ DGETRF, DGETRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) - AF( I, J ) = 1.D0 / DBLE( I+J ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - IP( J ) = J - IW( J ) = J - 20 CONTINUE - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE L and IPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* -* Test error exits of the routines that use the LU decomposition -* of a general matrix. -* -* DGETRF -* - SRNAMT = 'DGETRF' - INFOT = 1 - CALL CHAMELEON_DGETRF_INCPIV( -1, 0, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGETRF_INCPIV( 0, -1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGETRF_INCPIV( 2, 1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) -* -* DGETRS -* - SRNAMT = 'DGETRS' - INFOT = 103 - CALL CHAMELEON_DGETRS_INCPIV( '/', -1, 0, A, 1, HL, HPIV, - $ B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGETRS_INCPIV( CHAMELEONNOTRANS, -1, 0, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DGETRS_INCPIV( CHAMELEONNOTRANS, 0, -1, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 1, HL, - $ HPIV, B, 2, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_DGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 2, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE L and IPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* LAPACK Interface -* DGETRF -* - SRNAMT = 'DGETRF' - INFOT = 1 - CALL CHAMELEON_DGETRF( -1, 0, A, 1, IP, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGETRF( 0, -1, A, 1, IP, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGETRF( 2, 1, A, 1, IP, INFO ) - CALL CHKXER( 'DGETRF', INFOT, NOUT, INFO, OK ) -* -* DGETRS -* - SRNAMT = 'DGETRS' - INFOT = 1 - CALL CHAMELEON_DGETRS( '/', 0, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGETRS( CHAMELEONNOTRANS, -1, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DGETRS( CHAMELEONNOTRANS, 0, -1, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DGETRS( CHAMELEONNOTRANS, 2, 1, A, 1, IP, - $ B, 2, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_DGETRS( CHAMELEONNOTRANS, 2, 1, A, 2, IP, - $ B, 1, INFO ) - CALL CHKXER( 'DGETRS', INFOT, NOUT, INFO, OK ) -* - ENDIF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRGE -* - END diff --git a/testing/lin/derrlq.f b/testing/lin/derrlq.f deleted file mode 100644 index 4d02403d16471ee1d15e86f06b3a5e11d576cb58..0000000000000000000000000000000000000000 --- a/testing/lin/derrlq.f +++ /dev/null @@ -1,255 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRLQ( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRLQ tests the error exits for the DOUBLE PRECISION routines -* that use the LQ decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, DGELQ2, DGELQF, DORGL2, - $ DORGLQ, DORML2, DORMLQ -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) - AF( I, J ) = 1.D0 / DBLE( I+J ) - 10 CONTINUE - B( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGELQF( 2, 2, HT, INFO ) -* -* Error exits for LQ factorization -* -* CHAMELEON_DGELQF -* - SRNAMT = 'DGELQF' - INFOT = 1 - CALL CHAMELEON_DGELQF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'DGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGELQF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'DGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGELQF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'DGELQF', INFOT, NOUT, INFO, OK ) -* -* DGELQS -* - SRNAMT = 'DGELQS' - INFOT = 1 - CALL CHAMELEON_DGELQS( -1, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGELQS( 0, -1, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGELQS( 2, 1, 0, A, 2, HT, B, 1, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DGELQS( 0, 0, -1, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DGELQS( 2, 2, 0, A, 1, HT, B, 2, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_DGELQS( 1, 2, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGELQS', INFOT, NOUT, INFO, OK ) -* -* DORGLQ -* - SRNAMT = 'DORGLQ' - INFOT = 1 - CALL CHAMELEON_DORGLQ( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORGLQ( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORGLQ( 2, 1, 0, A, 2, HT, W, 2, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORGLQ( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORGLQ( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DORGLQ( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_DORGLQ( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'DORGLQ', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_DORMLQ -* - SRNAMT = 'DORMLQ' - INFOT = 1 - CALL CHAMELEON_DORMLQ( '/', CHAMELEONTRANS, 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, -1, 0, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, -1, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, 0, -1, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, 1, 1, A, 1, HT, AF, 1, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_DORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 1, 0, 1, A, 1, HT, AF, 1, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 2, 0, 2, A, 1, HT, AF, 2, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_DORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 0, 2, 2, A, 1, HT, AF, 1, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 2, HT, AF, 1, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_DORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, AF, 1, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_DORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, AF, 2, -* $ INFO ) -* CALL CHKXER( 'DORMLQ', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRLQ -* - END diff --git a/testing/lin/derrls.f b/testing/lin/derrls.f deleted file mode 100644 index f322c264f6ebecca99fd47c8e491a423bdabdcad..0000000000000000000000000000000000000000 --- a/testing/lin/derrls.f +++ /dev/null @@ -1,166 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRLS( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRLS tests the error exits for the DOUBLE PRECISION least squares -* driver routines (DGELS, SGELSS, SGELSX, SGELSY, SGELSD). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER INFO, IRNK - DOUBLE PRECISION RCOND - INTEGER HT( 2 ) -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), - $ W( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSX, - $ DGELSY -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) - A( 1, 1 ) = 1.0D+0 - A( 1, 2 ) = 2.0D+0 - A( 2, 2 ) = 3.0D+0 - A( 2, 1 ) = 4.0D+0 - OK = .TRUE. -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* - IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* Test error exits for the least squares driver routines. -* -* DGELS -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGELS( 2, 2, HT, INFO ) -* - SRNAMT = 'DGELS ' - INFOT = 103 - CALL CHAMELEON_DGELS( '/', 0, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGELS( CHAMELEONNOTRANS, -1, 0, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DGELS( CHAMELEONNOTRANS, 0, -1, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGELS( CHAMELEONNOTRANS, 0, 0, -1, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL CHAMELEON_DGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 1, HT, - $ B, 2, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_DGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 2, HT, - $ B, 1, INFO ) - CALL CHKXER( 'DGELS ', INFOT, NOUT, INFO, OK ) -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRLS -* - END diff --git a/testing/lin/derrpo.f b/testing/lin/derrpo.f deleted file mode 100644 index b135fce45da02393114b04d7256e60c4cca96c17..0000000000000000000000000000000000000000 --- a/testing/lin/derrpo.f +++ /dev/null @@ -1,180 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRPO( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRPO tests the error exits for the DOUBLE PRECISION routines -* for symmetric positive definite matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION ANRM, RCOND -* .. -* .. Local Arrays .. - INTEGER IW( NMAX ) - DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) - AF( I, J ) = 1.D0 / DBLE( I+J ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - IW( J ) = J - 20 CONTINUE - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* Test error exits of the routines that use the Cholesky -* decomposition of a symmetric positive definite matrix. -* -* DPOTRF -* - SRNAMT = 'DPOTRF' - INFOT = 1 - CALL CHAMELEON_DPOTRF( '/', 0, A, 1, INFO ) - CALL CHKXER( 'DPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DPOTRF( CHAMELEONUPPER, -1, A, 1, INFO ) - CALL CHKXER( 'DPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DPOTRF( CHAMELEONUPPER, 2, A, 1, INFO ) - CALL CHKXER( 'DPOTRF', INFOT, NOUT, INFO, OK ) -* -* DPOTRS -* - SRNAMT = 'DPOTRS' - INFOT = 1 - CALL CHAMELEON_DPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DPOTRS( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DPOTRS( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DPOTRS( CHAMELEONUPPER, 2, 1, A, 1, B, 2, INFO ) - CALL CHKXER( 'DPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_DPOTRS( CHAMELEONUPPER, 2, 1, A, 2, B, 1, INFO ) - CALL CHKXER( 'DPOTRS', INFOT, NOUT, INFO, OK ) - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRPO -* - END diff --git a/testing/lin/derrqr.f b/testing/lin/derrqr.f deleted file mode 100644 index 6f1eb3c40a835b9291585a0493c387a36b532627..0000000000000000000000000000000000000000 --- a/testing/lin/derrqr.f +++ /dev/null @@ -1,251 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRQR( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRQR tests the error exits for the DOUBLE PRECISION routines -* that use the QR decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, DGEQR2, DGEQRF, DORG2R, - $ DORGQR, DORM2R, DORMQR -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) - AF( I, J ) = 1.D0 / DBLE( I+J ) - 10 CONTINUE - B( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGEQRF( 2, 2, HT, INFO ) - -* -* Error exits for QR factorization -* -* CHAMELEON_DGEQRF -* - SRNAMT = 'DGEQRF' - INFOT = 1 - CALL CHAMELEON_DGEQRF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'DGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGEQRF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'DGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGEQRF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'DGEQRF', INFOT, NOUT, INFO, OK ) -* -* DGEQRS -* - SRNAMT = 'DGEQRS' - INFOT = 1 - CALL CHAMELEON_DGEQRS( -1, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGEQRS( 0, -1, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGEQRS( 1, 2, 0, A, 2, HT, B, 2, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DGEQRS( 0, 0, -1, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DGEQRS( 2, 1, 0, A, 1, HT, B, 2, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_DGEQRS( 2, 1, 0, A, 2, HT, B, 1, INFO ) - CALL CHKXER( 'DGEQRS', INFOT, NOUT, INFO, OK ) -* -* DORGQR -* - SRNAMT = 'DORGQR' - INFOT = 1 - CALL CHAMELEON_DORGQR( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORGQR( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORGQR( 1, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORGQR( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORGQR( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DORGQR( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_DORGQR( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'DORGQR', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_DORMQR -* - SRNAMT = 'DORMQR' - INFOT = 1 - CALL CHAMELEON_DORMQR( '/', CHAMELEONTRANS, 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DORMQR( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, -1, 0, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, -1, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, 0, -1, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, 1, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 0, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_DORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'DORMQR', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRQR -* - END diff --git a/testing/lin/derrvx.f b/testing/lin/derrvx.f deleted file mode 100644 index e71dcc696ebf576297c1e897551b43678074518b..0000000000000000000000000000000000000000 --- a/testing/lin/derrvx.f +++ /dev/null @@ -1,271 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DERRVX( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* DERRVX tests the error exits for the DOUBLE PRECISION driver routines -* for solving linear systems of equations. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER EQ - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION RCOND -* .. -* .. Local Arrays .. - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER IP( NMAX ), IW( NMAX ) - DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL CHKXER, DGBSV, DGBSVX, DGESV, DGESVX, DGTSV, - $ DGTSVX, DPBSV, DPBSVX, DPOSV, DPOSVX, DPPSV, - $ DPPSVX, DPTSV, DPTSVX, DSPSV, DSPSVX, DSYSV, - $ DSYSVX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1.D0 / DBLE( I+J ) - AF( I, J ) = 1.D0 / DBLE( I+J ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - C( J ) = 0.D0 - R( J ) = 0.D0 - IP( J ) = J - 20 CONTINUE - EQ = ' ' - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE HL and HPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_DGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* CHAMELEON_DGESV -* - SRNAMT = 'DGESV ' - INFOT = 1 - CALL CHAMELEON_DGESV_INCPIV( -1, 0, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGESV_INCPIV( 0, -1, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGESV_INCPIV( 2, 1, A, 1, HL, HPIV, B, 2, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_DGESV_INCPIV( 2, 1, A, 2, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE HL and HPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* -* DGESV -* - SRNAMT = 'DGESV ' - INFOT = 1 - CALL CHAMELEON_DGESV( -1, 0, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DGESV( 0, -1, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_DGESV( 2, 1, A, 1, IWORK, B, 2, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_DGESV( 2, 1, A, 2, IWORK, B, 1, INFO ) - CALL CHKXER( 'DGESV ', INFOT, NOUT, INFO, OK ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* DPOSV -* - SRNAMT = 'DPOSV ' - INFOT = 1 - CALL CHAMELEON_DPOSV( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_DPOSV( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_DPOSV( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'DPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_DPOSV( CHAMELEONUPPER, 2, 0, A, 1, B, 2, INFO ) - CALL CHKXER( 'DPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_DPOSV( CHAMELEONUPPER, 2, 0, A, 2, B, 1, INFO ) - CALL CHKXER( 'DPOSV ', INFOT, NOUT, INFO, OK ) -* -* DPOSVX -* - SRNAMT = 'DPOSVX' - INFOT = 1 - CALL DPOSVX( '/', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL DPOSVX( 'N', '/', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL DPOSVX( 'N', 'U', -1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL DPOSVX( 'N', 'U', 0, -1, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL DPOSVX( 'N', 'U', 2, 0, A, 1, AF, 2, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL DPOSVX( 'N', 'U', 2, 0, A, 2, AF, 1, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 9 - EQ = '/' - CALL DPOSVX( 'F', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 10 - EQ = 'Y' - CALL DPOSVX( 'F', 'U', 1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 12 - CALL DPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 1, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 14 - CALL DPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 2, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'DPOSVX', INFOT, NOUT, INFO, OK ) - END IF -* -* Print a summary line. -* - IF( OK ) THEN - WRITE( NOUT, FMT = 9999 )PATH - ELSE - WRITE( NOUT, FMT = 9998 )PATH - END IF -* - 9999 FORMAT( 1X, A3, ' drivers passed the tests of the error exits' ) - 9998 FORMAT( ' *** ', A3, ' drivers failed the tests of the error ', - $ 'exits ***' ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of DERRVX -* - END diff --git a/testing/lin/dgeequ.f b/testing/lin/dgeequ.f deleted file mode 100644 index 9958a519a7f76136c36f0c97b316d2ce0d5183b1..0000000000000000000000000000000000000000 --- a/testing/lin/dgeequ.f +++ /dev/null @@ -1,262 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, M, N - DOUBLE PRECISION AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), C( * ), R( * ) -* .. -* -* Purpose -* ======= -* -* DGEEQU computes row and column scalings intended to equilibrate an -* M-by-N matrix A and reduce its condition number. R returns the row -* scale factors and C the column scale factors, chosen to try to make -* the largest element in each row and column of the matrix B with -* elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1. -* -* R(i) and C(j) are restricted to be between SMLNUM = smallest safe -* number and BIGNUM = largest safe number. Use of these scaling -* factors is not guaranteed to reduce the condition number of A but -* works well in practice. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The M-by-N matrix whose equilibration factors are -* to be computed. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* R (output) DOUBLE PRECISION array, dimension (M) -* If INFO = 0 or INFO > M, R contains the row scale factors -* for A. -* -* C (output) DOUBLE PRECISION array, dimension (N) -* If INFO = 0, C contains the column scale factors for A. -* -* ROWCND (output) DOUBLE PRECISION -* If INFO = 0 or INFO > M, ROWCND contains the ratio of the -* smallest R(i) to the largest R(i). If ROWCND >= 0.1 and -* AMAX is neither too large nor too small, it is not worth -* scaling by R. -* -* COLCND (output) DOUBLE PRECISION -* If INFO = 0, COLCND contains the ratio of the smallest -* C(i) to the largest C(i). If COLCND >= 0.1, it is not -* worth scaling by C. -* -* AMAX (output) DOUBLE PRECISION -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= M: the i-th row of A is exactly zero -* > M: the (i-M)-th column of A is exactly zero -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DGEEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) THEN - ROWCND = ONE - COLCND = ONE - AMAX = ZERO - RETURN - END IF -* -* Get machine constants. -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* -* Compute row scale factors. -* - DO 10 I = 1, M - R( I ) = ZERO - 10 CONTINUE -* -* Find the maximum element in each row. -* - DO 30 J = 1, N - DO 20 I = 1, M - R( I ) = MAX( R( I ), ABS( A( I, J ) ) ) - 20 CONTINUE - 30 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 40 I = 1, M - RCMAX = MAX( RCMAX, R( I ) ) - RCMIN = MIN( RCMIN, R( I ) ) - 40 CONTINUE - AMAX = RCMAX -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 50 I = 1, M - IF( R( I ).EQ.ZERO ) THEN - INFO = I - RETURN - END IF - 50 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 60 I = 1, M - R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) - 60 CONTINUE -* -* Compute ROWCND = min(R(I)) / max(R(I)) -* - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* -* Compute column scale factors -* - DO 70 J = 1, N - C( J ) = ZERO - 70 CONTINUE -* -* Find the maximum element in each column, -* assuming the row scaling computed above. -* - DO 90 J = 1, N - DO 80 I = 1, M - C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) ) - 80 CONTINUE - 90 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 100 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 100 CONTINUE -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 110 J = 1, N - IF( C( J ).EQ.ZERO ) THEN - INFO = M + J - RETURN - END IF - 110 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 120 J = 1, N - C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) - 120 CONTINUE -* -* Compute COLCND = min(C(J)) / max(C(J)) -* - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* - RETURN -* -* End of DGEEQU -* - END diff --git a/testing/lin/dgennd.f b/testing/lin/dgennd.f deleted file mode 100644 index 34d06ccfcb4031de7a9bef324779d19b251e2bf3..0000000000000000000000000000000000000000 --- a/testing/lin/dgennd.f +++ /dev/null @@ -1,94 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - LOGICAL FUNCTION DGENND (M, N, A, LDA) - IMPLICIT NONE -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* February 2008 -* -* .. Scalar Arguments .. - INTEGER M, N, LDA -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DGENND tests that its argument has a non-negative diagonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows in A. -* -* N (input) INTEGER -* The number of columns in A. -* -* A (input) DOUBLE PRECISION array, dimension (LDA, N) -* The matrix. -* -* LDA (input) INTEGER -* Leading dimension of A. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - INTEGER I, K -* .. -* .. Intrinsics .. - INTRINSIC MIN -* .. -* .. Executable Statements .. - K = MIN( M, N ) - DO I = 1, K - IF( A( I, I ).LT.ZERO ) THEN - DGENND = .FALSE. - RETURN - END IF - END DO - DGENND = .TRUE. - RETURN - END diff --git a/testing/lin/dget02.f b/testing/lin/dget02.f deleted file mode 100644 index d656afb9a3543a74bc50a540cdc9b3bb87e31dd9..0000000000000000000000000000000000000000 --- a/testing/lin/dget02.f +++ /dev/null @@ -1,183 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DGET02 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A'*x = b, where A' is the transpose of A -* = 'C': A'*x = b, where A' is the transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - DOUBLE PRECISION ANORM, BNORM, RHSNORM, EPS, XNORM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DASUM, DLAMCH, DLANGE - EXTERNAL LSAME, DASUM, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - N1 = N - N2 = M - ELSE - N1 = M - N2 = N - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = DLANGE( '1', N1, N2, A, LDA, RWORK ) - RHSNORM = DLANGE( '1', N1, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL DGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, - $ LDX, ONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DASUM( N1, B( 1, J ), 1 ) - XNORM = DASUM( N2, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N1 *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of DGET02 -* - END diff --git a/testing/lin/dget04.f b/testing/lin/dget04.f deleted file mode 100644 index 709943006a3aec303c064732b78e55840156612d..0000000000000000000000000000000000000000 --- a/testing/lin/dget04.f +++ /dev/null @@ -1,154 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDX, LDXACT, N, NRHS - DOUBLE PRECISION RCOND, RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* DGET04 computes the difference between a computed solution and the -* true solution to a system of linear equations. -* -* RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), -* where RCOND is the reciprocal of the condition number and EPS is the -* machine epsilon. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of rows of the matrices X and XACT. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and XACT. NRHS >= 0. -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) DOUBLE PRECISION array, dimension( LDX, NRHS ) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* RCOND (input) DOUBLE PRECISION -* The reciprocal of the condition number of the coefficient -* matrix in the system of equations. -* -* RESID (output) DOUBLE PRECISION -* The maximum over the NRHS solution vectors of -* ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, IX, J - DOUBLE PRECISION DIFFNM, EPS, XNORM -* .. -* .. External Functions .. - INTEGER IDAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL IDAMAX, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if RCOND is invalid. -* - EPS = DLAMCH( 'Epsilon' ) - IF( RCOND.LT.ZERO ) THEN - RESID = 1.0D0 / EPS - RETURN - END IF -* -* Compute the maximum of -* norm(X - XACT) / ( norm(XACT) * EPS ) -* over all the vectors X and XACT . -* - RESID = ZERO - DO 20 J = 1, NRHS - IX = IDAMAX( N, XACT( 1, J ), 1 ) - XNORM = ABS( XACT( IX, J ) ) - DIFFNM = ZERO - DO 10 I = 1, N - DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE - IF( XNORM.LE.ZERO ) THEN - IF( DIFFNM.GT.ZERO ) - $ RESID = 1.0D0 / EPS - ELSE - RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) - END IF - 20 CONTINUE - IF( RESID*EPS.LT.1.0D0 ) - $ RESID = RESID / EPS -* - RETURN -* -* End of DGET04 -* - END diff --git a/testing/lin/dget06.f b/testing/lin/dget06.f deleted file mode 100644 index 98464e9edf23c51df706b213d037350374350472..0000000000000000000000000000000000000000 --- a/testing/lin/dget06.f +++ /dev/null @@ -1,102 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DGET06( RCOND, RCONDC ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - DOUBLE PRECISION RCOND, RCONDC -* .. -* -* Purpose -* ======= -* -* DGET06 computes a test ratio to compare two values for RCOND. -* -* Arguments -* ========== -* -* RCOND (input) DOUBLE PRECISION -* The estimate of the reciprocal of the condition number of A, -* as computed by DGECON. -* -* RCONDC (input) DOUBLE PRECISION -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(inv(A)). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - DOUBLE PRECISION EPS, RAT -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) - IF( RCOND.GT.ZERO ) THEN - IF( RCONDC.GT.ZERO ) THEN - RAT = MAX( RCOND, RCONDC ) / MIN( RCOND, RCONDC ) - - $ ( ONE-EPS ) - ELSE - RAT = RCOND / EPS - END IF - ELSE - IF( RCONDC.GT.ZERO ) THEN - RAT = RCONDC / EPS - ELSE - RAT = ZERO - END IF - END IF - DGET06 = RAT - RETURN -* -* End of DGET06 -* - END diff --git a/testing/lin/dlabad.f b/testing/lin/dlabad.f deleted file mode 100644 index 318b2a68957072b6d2bf263da7117874edf0c716..0000000000000000000000000000000000000000 --- a/testing/lin/dlabad.f +++ /dev/null @@ -1,92 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLABAD( SMALL, LARGE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - DOUBLE PRECISION LARGE, SMALL -* .. -* -* Purpose -* ======= -* -* DLABAD takes as input the values computed by DLAMCH for underflow and -* overflow, and returns the square root of each of these values if the -* log of LARGE is sufficiently large. This subroutine is intended to -* identify machines with a large exponent range, such as the Crays, and -* redefine the underflow and overflow limits to be the square roots of -* the values computed by DLAMCH. This subroutine is needed because -* DLAMCH does not compensate for poor arithmetic in the upper half of -* the exponent range, as is found on a Cray. -* -* Arguments -* ========= -* -* SMALL (input/output) DOUBLE PRECISION -* On entry, the underflow threshold as computed by DLAMCH. -* On exit, if LOG10(LARGE) is sufficiently large, the square -* root of SMALL, otherwise unchanged. -* -* LARGE (input/output) DOUBLE PRECISION -* On entry, the overflow threshold as computed by DLAMCH. -* On exit, if LOG10(LARGE) is sufficiently large, the square -* root of LARGE, otherwise unchanged. -* -* ===================================================================== -* -* .. Intrinsic Functions .. - INTRINSIC LOG10, SQRT -* .. -* .. Executable Statements .. -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - IF( LOG10( LARGE ).GT.2000.D0 ) THEN - SMALL = SQRT( SMALL ) - LARGE = SQRT( LARGE ) - END IF -* - RETURN -* -* End of DLABAD -* - END diff --git a/testing/lin/dlacn2.f b/testing/lin/dlacn2.f deleted file mode 100644 index 31d7265d1870ec27d8cdb919776764557a10c6c9..0000000000000000000000000000000000000000 --- a/testing/lin/dlacn2.f +++ /dev/null @@ -1,251 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER KASE, N - DOUBLE PRECISION EST -* .. -* .. Array Arguments .. - INTEGER ISGN( * ), ISAVE( 3 ) - DOUBLE PRECISION V( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* DLACN2 estimates the 1-norm of a square, real matrix A. -* Reverse communication is used for evaluating matrix-vector products. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix. N >= 1. -* -* V (workspace) DOUBLE PRECISION array, dimension (N) -* On the final return, V = A*W, where EST = norm(V)/norm(W) -* (W is not returned). -* -* X (input/output) DOUBLE PRECISION array, dimension (N) -* On an intermediate return, X should be overwritten by -* A * X, if KASE=1, -* A' * X, if KASE=2, -* and DLACN2 must be re-called with all the other parameters -* unchanged. -* -* ISGN (workspace) INTEGER array, dimension (N) -* -* EST (input/output) DOUBLE PRECISION -* On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be -* unchanged from the previous call to DLACN2. -* On exit, EST is an estimate (a lower bound) for norm(A). -* -* KASE (input/output) INTEGER -* On the initial call to DLACN2, KASE should be 0. -* On an intermediate return, KASE will be 1 or 2, indicating -* whether X should be overwritten by A * X or A' * X. -* On the final return from DLACN2, KASE will again be 0. -* -* ISAVE (input/output) INTEGER array, dimension (3) -* ISAVE is used to save variables between calls to DLACN2 -* -* Further Details -* ======= ======= -* -* Contributed by Nick Higham, University of Manchester. -* Originally named SONEST, dated March 16, 1988. -* -* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of -* a real or complex matrix, with applications to condition estimation", -* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. -* -* This is a thread safe version of DLACON, which uses the array ISAVE -* in place of a SAVE statement, as follows: -* -* DLACON DLACN2 -* JUMP ISAVE(1) -* J ISAVE(2) -* ITER ISAVE(3) -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - DOUBLE PRECISION ZERO, ONE, TWO - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, JLAST - DOUBLE PRECISION ALTSGN, ESTOLD, TEMP -* .. -* .. External Functions .. - INTEGER IDAMAX - DOUBLE PRECISION DASUM - EXTERNAL IDAMAX, DASUM -* .. -* .. External Subroutines .. - EXTERNAL DCOPY -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, NINT, SIGN -* .. -* .. Executable Statements .. -* - IF( KASE.EQ.0 ) THEN - DO 10 I = 1, N - X( I ) = ONE / DBLE( N ) - 10 CONTINUE - KASE = 1 - ISAVE( 1 ) = 1 - RETURN - END IF -* - GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 ) -* -* ................ ENTRY (ISAVE( 1 ) = 1) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. -* - 20 CONTINUE - IF( N.EQ.1 ) THEN - V( 1 ) = X( 1 ) - EST = ABS( V( 1 ) ) -* ... QUIT - GO TO 150 - END IF - EST = DASUM( N, X, 1 ) -* - DO 30 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) - ISGN( I ) = NINT( X( I ) ) - 30 CONTINUE - KASE = 2 - ISAVE( 1 ) = 2 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 2) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. -* - 40 CONTINUE - ISAVE( 2 ) = IDAMAX( N, X, 1 ) - ISAVE( 3 ) = 2 -* -* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. -* - 50 CONTINUE - DO 60 I = 1, N - X( I ) = ZERO - 60 CONTINUE - X( ISAVE( 2 ) ) = ONE - KASE = 1 - ISAVE( 1 ) = 3 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 3) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 70 CONTINUE - CALL DCOPY( N, X, 1, V, 1 ) - ESTOLD = EST - EST = DASUM( N, V, 1 ) - DO 80 I = 1, N - IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) ) - $ GO TO 90 - 80 CONTINUE -* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. - GO TO 120 -* - 90 CONTINUE -* TEST FOR CYCLING. - IF( EST.LE.ESTOLD ) - $ GO TO 120 -* - DO 100 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) - ISGN( I ) = NINT( X( I ) ) - 100 CONTINUE - KASE = 2 - ISAVE( 1 ) = 4 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 4) -* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. -* - 110 CONTINUE - JLAST = ISAVE( 2 ) - ISAVE( 2 ) = IDAMAX( N, X, 1 ) - IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND. - $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN - ISAVE( 3 ) = ISAVE( 3 ) + 1 - GO TO 50 - END IF -* -* ITERATION COMPLETE. FINAL STAGE. -* - 120 CONTINUE - ALTSGN = ONE - DO 130 I = 1, N - X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) - ALTSGN = -ALTSGN - 130 CONTINUE - KASE = 1 - ISAVE( 1 ) = 5 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 5) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 140 CONTINUE - TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) ) - IF( TEMP.GT.EST ) THEN - CALL DCOPY( N, X, 1, V, 1 ) - EST = TEMP - END IF -* - 150 CONTINUE - KASE = 0 - RETURN -* -* End of DLACN2 -* - END diff --git a/testing/lin/dlagge.f b/testing/lin/dlagge.f deleted file mode 100644 index 4b24781081daf3682b81eacf13e9e0769cdcaa01..0000000000000000000000000000000000000000 --- a/testing/lin/dlagge.f +++ /dev/null @@ -1,326 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, KL, KU, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* DLAGGE generates a real general m by n matrix A, by pre- and post- -* multiplying a real diagonal matrix D with random orthogonal matrices: -* A = U*D*V. The lower and upper bandwidths may then be reduced to -* kl and ku by additional orthogonal transformations. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= KL <= M-1. -* -* KU (input) INTEGER -* The number of nonzero superdiagonals within the band of A. -* 0 <= KU <= N-1. -* -* D (input) DOUBLE PRECISION array, dimension (min(M,N)) -* The diagonal elements of the diagonal matrix D. -* -* A (output) DOUBLE PRECISION array, dimension (LDA,N) -* The generated m by n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (M+N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION TAU, WA, WB, WN -* .. -* .. External Subroutines .. - EXTERNAL DGEMV, DGER, DLARNV, DSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, SIGN -* .. -* .. External Functions .. - DOUBLE PRECISION DNRM2 - EXTERNAL DNRM2 -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN - INFO = -3 - ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -7 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'DLAGGE', -INFO ) - RETURN - END IF -* -* initialize A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = 1, M - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( M, N ) - A( I, I ) = D( I ) - 30 CONTINUE -* -* pre- and post-multiply A by random orthogonal matrices -* - DO 40 I = MIN( M, N ), 1, -1 - IF( I.LT.M ) THEN -* -* generate random reflection -* - CALL DLARNV( 3, ISEED, M-I+1, WORK ) - WN = DNRM2( M-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL DSCAL( M-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* multiply A(i:m,i:n) by random reflection from the left -* - CALL DGEMV( 'Transpose', M-I+1, N-I+1, ONE, A( I, I ), LDA, - $ WORK, 1, ZERO, WORK( M+1 ), 1 ) - CALL DGER( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1, - $ A( I, I ), LDA ) - END IF - IF( I.LT.N ) THEN -* -* generate random reflection -* - CALL DLARNV( 3, ISEED, N-I+1, WORK ) - WN = DNRM2( N-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* multiply A(i:m,i:n) by random reflection from the right -* - CALL DGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ), - $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 ) - CALL DGER( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, - $ A( I, I ), LDA ) - END IF - 40 CONTINUE -* -* Reduce number of subdiagonals to KL and number of superdiagonals -* to KU -* - DO 70 I = 1, MAX( M-1-KL, N-1-KU ) - IF( KL.LE.KU ) THEN -* -* annihilate subdiagonal elements first (necessary if KL = 0) -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = DNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = SIGN( WN, A( KL+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL DSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL DGEMV( 'Transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL DGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1, - $ A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = DNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = SIGN( WN, A( I, KU+I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL DSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL DGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL DGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF - ELSE -* -* annihilate superdiagonal elements first (necessary if -* KU = 0) -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = DNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = SIGN( WN, A( I, KU+I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL DSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL DGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL DGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = DNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = SIGN( WN, A( KL+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL DSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL DGEMV( 'Transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL DGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1, - $ A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF - END IF -* - DO 50 J = KL + I + 1, M - A( J, I ) = ZERO - 50 CONTINUE -* - DO 60 J = KU + I + 1, N - A( I, J ) = ZERO - 60 CONTINUE - 70 CONTINUE - RETURN -* -* End of DLAGGE -* - END diff --git a/testing/lin/dlagsy.f b/testing/lin/dlagsy.f deleted file mode 100644 index a6ae59a60eb3a63c9655df753c006e3f27aeef9e..0000000000000000000000000000000000000000 --- a/testing/lin/dlagsy.f +++ /dev/null @@ -1,236 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, K, LDA, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* DLAGSY generates a real symmetric matrix A, by pre- and post- -* multiplying a real diagonal matrix D with a random orthogonal matrix: -* A = U*D*U'. The semi-bandwidth may then be reduced to k by additional -* orthogonal transformations. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* K (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= K <= N-1. -* -* D (input) DOUBLE PRECISION array, dimension (N) -* The diagonal elements of the diagonal matrix D. -* -* A (output) DOUBLE PRECISION array, dimension (LDA,N) -* The generated n by n symmetric matrix A (the full matrix is -* stored). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= N. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (2*N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, HALF - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, HALF = 0.5D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION ALPHA, TAU, WA, WB, WN -* .. -* .. External Subroutines .. - EXTERNAL DAXPY, DGEMV, DGER, DLARNV, DSCAL, DSYMV, - $ DSYR2, XERBLA -* .. -* .. External Functions .. - DOUBLE PRECISION DDOT, DNRM2 - EXTERNAL DDOT, DNRM2 -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, SIGN -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'DLAGSY', -INFO ) - RETURN - END IF -* -* initialize lower triangle of A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = J + 1, N - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, N - A( I, I ) = D( I ) - 30 CONTINUE -* -* Generate lower triangle of symmetric matrix -* - DO 40 I = N - 1, 1, -1 -* -* generate random reflection -* - CALL DLARNV( 3, ISEED, N-I+1, WORK ) - WN = DNRM2( N-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* apply random reflection to A(i:n,i:n) from the left -* and the right -* -* compute y := tau * A * u -* - CALL DSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO, - $ WORK( N+1 ), 1 ) -* -* compute v := y - 1/2 * tau * ( y, u ) * u -* - ALPHA = -HALF*TAU*DDOT( N-I+1, WORK( N+1 ), 1, WORK, 1 ) - CALL DAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 ) -* -* apply the transformation as a rank-2 update to A(i:n,i:n) -* - CALL DSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1, - $ A( I, I ), LDA ) - 40 CONTINUE -* -* Reduce number of subdiagonals to K -* - DO 60 I = 1, N - 1 - K -* -* generate reflection to annihilate A(k+i+1:n,i) -* - WN = DNRM2( N-K-I+1, A( K+I, I ), 1 ) - WA = SIGN( WN, A( K+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( K+I, I ) + WA - CALL DSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 ) - A( K+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(k+i:n,i+1:k+i-1) from the left -* - CALL DGEMV( 'Transpose', N-K-I+1, K-1, ONE, A( K+I, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL DGER( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1, - $ A( K+I, I+1 ), LDA ) -* -* apply reflection to A(k+i:n,k+i:n) from the left and the right -* -* compute y := tau * A * u -* - CALL DSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) -* -* compute v := y - 1/2 * tau * ( y, u ) * u -* - ALPHA = -HALF*TAU*DDOT( N-K-I+1, WORK, 1, A( K+I, I ), 1 ) - CALL DAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 ) -* -* apply symmetric rank-2 update to A(k+i:n,k+i:n) -* - CALL DSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1, - $ A( K+I, K+I ), LDA ) -* - A( K+I, I ) = -WA - DO 50 J = K + I + 1, N - A( J, I ) = ZERO - 50 CONTINUE - 60 CONTINUE -* -* Store full symmetric matrix -* - DO 80 J = 1, N - DO 70 I = J + 1, N - A( J, I ) = A( I, J ) - 70 CONTINUE - 80 CONTINUE - RETURN -* -* End of DLAGSY -* - END diff --git a/testing/lin/dlaord.f b/testing/lin/dlaord.f deleted file mode 100644 index 08902ccfd44d4d0ba9a30fde1fe57e65f2eca62f..0000000000000000000000000000000000000000 --- a/testing/lin/dlaord.f +++ /dev/null @@ -1,138 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAORD( JOB, N, X, INCX ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER JOB - INTEGER INCX, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION X( * ) -* .. -* -* Purpose -* ======= -* -* DLAORD sorts the elements of a vector x in increasing or decreasing -* order. -* -* Arguments -* ========= -* -* JOB (input) CHARACTER -* = 'I': Sort in increasing order -* = 'D': Sort in decreasing order -* -* N (input) INTEGER -* The length of the vector X. -* -* X (input/output) DOUBLE PRECISION array, dimension -* (1+(N-1)*INCX) -* On entry, the vector of length n to be sorted. -* On exit, the vector x is sorted in the prescribed order. -* -* INCX (input) INTEGER -* The spacing between successive elements of X. INCX >= 0. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, INC, IX, IXNEXT - DOUBLE PRECISION TEMP -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* - INC = ABS( INCX ) - IF( LSAME( JOB, 'I' ) ) THEN -* -* Sort in increasing order -* - DO 20 I = 2, N - IX = 1 + ( I-1 )*INC - 10 CONTINUE - IF( IX.EQ.1 ) - $ GO TO 20 - IXNEXT = IX - INC - IF( X( IX ).GT.X( IXNEXT ) ) THEN - GO TO 20 - ELSE - TEMP = X( IX ) - X( IX ) = X( IXNEXT ) - X( IXNEXT ) = TEMP - END IF - IX = IXNEXT - GO TO 10 - 20 CONTINUE -* - ELSE IF( LSAME( JOB, 'D' ) ) THEN -* -* Sort in decreasing order -* - DO 40 I = 2, N - IX = 1 + ( I-1 )*INC - 30 CONTINUE - IF( IX.EQ.1 ) - $ GO TO 40 - IXNEXT = IX - INC - IF( X( IX ).LT.X( IXNEXT ) ) THEN - GO TO 40 - ELSE - TEMP = X( IX ) - X( IX ) = X( IXNEXT ) - X( IXNEXT ) = TEMP - END IF - IX = IXNEXT - GO TO 30 - 40 CONTINUE - END IF - RETURN -* -* End of DLAORD -* - END diff --git a/testing/lin/dlaqge.f b/testing/lin/dlaqge.f deleted file mode 100644 index fcf9d48f30f3eba751dd533a3afc468e215a9742..0000000000000000000000000000000000000000 --- a/testing/lin/dlaqge.f +++ /dev/null @@ -1,191 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED - INTEGER LDA, M, N - DOUBLE PRECISION AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), C( * ), R( * ) -* .. -* -* Purpose -* ======= -* -* DLAQGE equilibrates a general M by N matrix A using the row and -* column scaling factors in the vectors R and C. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the M by N matrix A. -* On exit, the equilibrated matrix. See EQUED for the form of -* the equilibrated matrix. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(M,1). -* -* R (input) DOUBLE PRECISION array, dimension (M) -* The row scale factors for A. -* -* C (input) DOUBLE PRECISION array, dimension (N) -* The column scale factors for A. -* -* ROWCND (input) DOUBLE PRECISION -* Ratio of the smallest R(i) to the largest R(i). -* -* COLCND (input) DOUBLE PRECISION -* Ratio of the smallest C(i) to the largest C(i). -* -* AMAX (input) DOUBLE PRECISION -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration -* = 'R': Row equilibration, i.e., A has been premultiplied by -* diag(R). -* = 'C': Column equilibration, i.e., A has been postmultiplied -* by diag(C). -* = 'B': Both row and column equilibration, i.e., A has been -* replaced by diag(R) * A * diag(C). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if row or column scaling -* should be done based on the ratio of the row or column scaling -* factors. If ROWCND < THRESH, row scaling is done, and if -* COLCND < THRESH, column scaling is done. -* -* LARGE and SMALL are threshold values used to decide if row scaling -* should be done based on the absolute size of the largest matrix -* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, THRESH - PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION CJ, LARGE, SMALL -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( M.LE.0 .OR. N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) - $ THEN -* -* No row scaling -* - IF( COLCND.GE.THRESH ) THEN -* -* No column scaling -* - EQUED = 'N' - ELSE -* -* Column scaling -* - DO 20 J = 1, N - CJ = C( J ) - DO 10 I = 1, M - A( I, J ) = CJ*A( I, J ) - 10 CONTINUE - 20 CONTINUE - EQUED = 'C' - END IF - ELSE IF( COLCND.GE.THRESH ) THEN -* -* Row scaling, no column scaling -* - DO 40 J = 1, N - DO 30 I = 1, M - A( I, J ) = R( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - EQUED = 'R' - ELSE -* -* Row and column scaling -* - DO 60 J = 1, N - CJ = C( J ) - DO 50 I = 1, M - A( I, J ) = CJ*R( I )*A( I, J ) - 50 CONTINUE - 60 CONTINUE - EQUED = 'B' - END IF -* - RETURN -* -* End of DLAQGE -* - END diff --git a/testing/lin/dlaqsy.f b/testing/lin/dlaqsy.f deleted file mode 100644 index b00d055d86a4e211e0bf818ca81cbdc28f6b4ebc..0000000000000000000000000000000000000000 --- a/testing/lin/dlaqsy.f +++ /dev/null @@ -1,178 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - DOUBLE PRECISION AMAX, SCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), S( * ) -* .. -* -* Purpose -* ======= -* -* DLAQSY equilibrates a symmetric matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the symmetric 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) DOUBLE PRECISION array, dimension (N) -* The scale factors for A. -* -* SCOND (input) DOUBLE PRECISION -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) DOUBLE PRECISION -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, THRESH - PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - DO 30 I = J, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of DLAQSY -* - END diff --git a/testing/lin/dlaran.f b/testing/lin/dlaran.f deleted file mode 100644 index 6187cc99cbc9056a369dfa365c94f709f5b0b385..0000000000000000000000000000000000000000 --- a/testing/lin/dlaran.f +++ /dev/null @@ -1,143 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DLARAN( ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* DLARAN returns a random real number from a uniform (0,1) -* distribution. -* -* Arguments -* ========= -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine uses a multiplicative congruential method with modulus -* 2**48 and multiplier 33952834046453 (see G.S.Fishman, -* 'Multiplicative congruential random number generators with modulus -* 2**b: an exhaustive analysis for b = 32 and a partial analysis for -* b = 48', Math. Comp. 189, pp 331-344, 1990). -* -* 48-bit integers are stored in 4 integer array elements with 12 bits -* per element. Hence the routine is portable across machines with -* integers of 32 bits or more. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER M1, M2, M3, M4 - PARAMETER ( M1 = 494, M2 = 322, M3 = 2508, M4 = 2549 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - INTEGER IPW2 - DOUBLE PRECISION R - PARAMETER ( IPW2 = 4096, R = ONE / IPW2 ) -* .. -* .. Local Scalars .. - INTEGER IT1, IT2, IT3, IT4 - DOUBLE PRECISION RNDOUT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MOD -* .. -* .. Executable Statements .. - 10 CONTINUE -* -* multiply the seed by the multiplier modulo 2**48 -* - IT4 = ISEED( 4 )*M4 - IT3 = IT4 / IPW2 - IT4 = IT4 - IPW2*IT3 - IT3 = IT3 + ISEED( 3 )*M4 + ISEED( 4 )*M3 - IT2 = IT3 / IPW2 - IT3 = IT3 - IPW2*IT2 - IT2 = IT2 + ISEED( 2 )*M4 + ISEED( 3 )*M3 + ISEED( 4 )*M2 - IT1 = IT2 / IPW2 - IT2 = IT2 - IPW2*IT1 - IT1 = IT1 + ISEED( 1 )*M4 + ISEED( 2 )*M3 + ISEED( 3 )*M2 + - $ ISEED( 4 )*M1 - IT1 = MOD( IT1, IPW2 ) -* -* return updated seed -* - ISEED( 1 ) = IT1 - ISEED( 2 ) = IT2 - ISEED( 3 ) = IT3 - ISEED( 4 ) = IT4 -* -* convert 48-bit integer to a real number in the interval (0,1) -* - RNDOUT = R*( DBLE( IT1 )+R*( DBLE( IT2 )+R*( DBLE( IT3 )+R* - $ ( DBLE( IT4 ) ) ) ) ) -* - IF (RNDOUT.EQ.1.0D+0) THEN -* If a real number has n bits of precision, and the first -* n bits of the 48-bit integer above happen to be all 1 (which -* will occur about once every 2**n calls), then DLARAN will -* be rounded to exactly 1.0. -* Since DLARAN is not supposed to return exactly 0.0 or 1.0 -* (and some callers of DLARAN, such as CLARND, depend on that), -* the statistically correct thing to do in this situation is -* simply to iterate again. -* N.B. the case DLARAN = 0.0 should not be possible. -* - GOTO 10 - END IF -* - DLARAN = RNDOUT - RETURN -* -* End of DLARAN -* - END diff --git a/testing/lin/dlarhs.f b/testing/lin/dlarhs.f deleted file mode 100644 index 55df7288deafab75de6e1b8433cd5e3eee2a3bf9..0000000000000000000000000000000000000000 --- a/testing/lin/dlarhs.f +++ /dev/null @@ -1,357 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, - $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DLARHS chooses a set of NRHS random solution vectors and sets -* up the right hand sides for the linear system -* op( A ) * X = B, -* where op( A ) may be A or A' (transpose of A). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The type of the real matrix A. PATH may be given in any -* combination of upper and lower case. Valid types include -* xGE: General m x n matrix -* xGB: General banded matrix -* xPO: Symmetric positive definite, 2-D storage -* xPP: Symmetric positive definite packed -* xPB: Symmetric positive definite banded -* xSY: Symmetric indefinite, 2-D storage -* xSP: Symmetric indefinite packed -* xSB: Symmetric indefinite banded -* xTR: Triangular -* xTP: Triangular packed -* xTB: Triangular banded -* xQR: General m x n matrix -* xLQ: General m x n matrix -* xQL: General m x n matrix -* xRQ: General m x n matrix -* where the leading character indicates the precision. -* -* XTYPE (input) CHARACTER*1 -* Specifies how the exact solution X will be determined: -* = 'N': New solution; generate a random X. -* = 'C': Computed; use value of X on entry. -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* matrix A is stored, if A is symmetric. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to the matrix A. -* = 'N': System is A * x = b -* = 'T': System is A'* x = b -* = 'C': System is A'* x = b -* -* M (input) INTEGER -* The number or rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* Used only if A is a band matrix; specifies the number of -* subdiagonals of A if A is a general band matrix or if A is -* symmetric or triangular and UPLO = 'L'; specifies the number -* of superdiagonals of A if A is symmetric or triangular and -* UPLO = 'U'. 0 <= KL <= M-1. -* -* KU (input) INTEGER -* Used only if A is a general band matrix or if A is -* triangular. -* -* If PATH = xGB, specifies the number of superdiagonals of A, -* and 0 <= KU <= N-1. -* -* If PATH = xTR, xTP, or xTB, specifies whether or not the -* matrix has unit diagonal: -* = 1: matrix has non-unit diagonal (default) -* = 2: matrix has unit diagonal -* -* NRHS (input) INTEGER -* The number of right hand side vectors in the system A*X = B. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The test matrix whose type is given by PATH. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* If PATH = xGB, LDA >= KL+KU+1. -* If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. -* Otherwise, LDA >= max(1,M). -* -* X (input or output) DOUBLE PRECISION array, dimension(LDX,NRHS) -* On entry, if XTYPE = 'C' (for 'Computed'), then X contains -* the exact solution to the system of linear equations. -* On exit, if XTYPE = 'N' (for 'New'), then X is initialized -* with random values. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). -* -* B (output) DOUBLE PRECISION array, dimension (LDB,NRHS) -* The right hand side vector(s) for the system of equations, -* computed from B = op(A) * X, where op(A) is determined by -* TRANS. -* -* LDB (input) INTEGER -* The leading dimension of the array B. If TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). -* -* ISEED (input/output) INTEGER array, dimension (4) -* The seed vector for the random number generator (used in -* DLATMS). Modified on exit. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI - CHARACTER C1, DIAG - CHARACTER*2 C2 - INTEGER J, MB, NX -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL DGBMV, DGEMM, DLACPY, DLARNV, DSBMV, DSPMV, - $ DSYMM, DTBMV, DTPMV, DTRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) - NOTRAN = .NOT.TRAN - GEN = LSAME( PATH( 2: 2 ), 'G' ) - QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) - SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. LSAME( PATH( 2: 2 ), 'S' ) - TRI = LSAME( PATH( 2: 2 ), 'T' ) - BAND = LSAME( PATH( 3: 3 ), 'B' ) - IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN - INFO = -1 - ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) - $ THEN - INFO = -2 - ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. - $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN - INFO = -3 - ELSE IF( ( GEN .OR. QRS ) .AND. .NOT. - $ ( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN - INFO = -4 - ELSE IF( M.LT.0 ) THEN - INFO = -5 - ELSE IF( N.LT.0 ) THEN - INFO = -6 - ELSE IF( BAND .AND. KL.LT.0 ) THEN - INFO = -7 - ELSE IF( BAND .AND. KU.LT.0 ) THEN - INFO = -8 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -9 - ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. - $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. - $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN - INFO = -11 - ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. - $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN - INFO = -13 - ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. - $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN - INFO = -15 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLARHS', -INFO ) - RETURN - END IF -* -* Initialize X to NRHS random vectors unless XTYPE = 'C'. -* - IF( TRAN ) THEN - NX = M - MB = N - ELSE - NX = N - MB = M - END IF - IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN - DO 10 J = 1, NRHS - CALL DLARNV( 2, ISEED, N, X( 1, J ) ) - 10 CONTINUE - END IF -* -* Multiply X by op( A ) using an appropriate -* matrix multiply routine. -* - IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. - $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. - $ LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* General matrix -* - CALL DGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, - $ ZERO, B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'SY' ) ) THEN -* -* Symmetric matrix, 2-D storage -* - CALL DSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* General matrix, band storage -* - DO 20 J = 1, NRHS - CALL DGBMV( TRANS, MB, NX, KL, KU, ONE, A, LDA, X( 1, J ), - $ 1, ZERO, B( 1, J ), 1 ) - 20 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* Symmetric matrix, band storage -* - DO 30 J = 1, NRHS - CALL DSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 30 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* Symmetric matrix, packed storage -* - DO 40 J = 1, NRHS - CALL DSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 40 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN -* -* Triangular matrix. Note that for triangular matrices, -* KU = 1 => non-unit triangular -* KU = 2 => unit triangular -* - CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - CALL DTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, - $ LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN -* -* Triangular matrix, packed storage -* - CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 50 J = 1, NRHS - CALL DTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) - 50 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* Triangular matrix, banded storage -* - CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 60 J = 1, NRHS - CALL DTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) - 60 CONTINUE -* - ELSE -* -* If PATH is none of the above, return with an error code. -* - INFO = -1 - CALL XERBLA( 'DLARHS', -INFO ) - END IF -* - RETURN -* -* End of DLARHS -* - END diff --git a/testing/lin/dlarnd.f b/testing/lin/dlarnd.f deleted file mode 100644 index 258a9102de25e8677c308abe4e6f81b596619597..0000000000000000000000000000000000000000 --- a/testing/lin/dlarnd.f +++ /dev/null @@ -1,124 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DLARND( IDIST, ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* DLARND returns a random real number from a uniform or normal -* distribution. -* -* Arguments -* ========= -* -* IDIST (input) INTEGER -* Specifies the distribution of the random numbers: -* = 1: uniform (0,1) -* = 2: uniform (-1,1) -* = 3: normal (0,1) -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine calls the auxiliary routine DLARAN to generate a random -* real number from a uniform (0,1) distribution. The Box-Muller method -* is used to transform numbers from a uniform to a normal distribution. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, TWO - PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 ) - DOUBLE PRECISION TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 ) -* .. -* .. Local Scalars .. - DOUBLE PRECISION T1, T2 -* .. -* .. External Functions .. - DOUBLE PRECISION DLARAN - EXTERNAL DLARAN -* .. -* .. Intrinsic Functions .. - INTRINSIC COS, LOG, SQRT -* .. -* .. Executable Statements .. -* -* Generate a real random number from a uniform (0,1) distribution -* - T1 = DLARAN( ISEED ) -* - IF( IDIST.EQ.1 ) THEN -* -* uniform (0,1) -* - DLARND = T1 - ELSE IF( IDIST.EQ.2 ) THEN -* -* uniform (-1,1) -* - DLARND = TWO*T1 - ONE - ELSE IF( IDIST.EQ.3 ) THEN -* -* normal (0,1) -* - T2 = DLARAN( ISEED ) - DLARND = SQRT( -TWO*LOG( T1 ) )*COS( TWOPI*T2 ) - END IF - RETURN -* -* End of DLARND -* - END diff --git a/testing/lin/dlaror.f b/testing/lin/dlaror.f deleted file mode 100644 index f5a21884325bbac9710451a3319bc77f50094565..0000000000000000000000000000000000000000 --- a/testing/lin/dlaror.f +++ /dev/null @@ -1,275 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER INIT, SIDE - INTEGER INFO, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* DLAROR pre- or post-multiplies an M by N matrix A by a random -* orthogonal matrix U, overwriting A. A may optionally be initialized -* to the identity matrix before multiplying by U. U is generated using -* the method of G.W. Stewart (SIAM J. Numer. Anal. 17, 1980, 403-409). -* -* Arguments -* ========= -* -* SIDE (input) CHARACTER*1 -* Specifies whether A is multiplied on the left or right by U. -* = 'L': Multiply A on the left (premultiply) by U -* = 'R': Multiply A on the right (postmultiply) by U' -* = 'C' or 'T': Multiply A on the left by U and the right -* by U' (Here, U' means U-transpose.) -* -* INIT (input) CHARACTER*1 -* Specifies whether or not A should be initialized to the -* identity matrix. -* = 'I': Initialize A to (a section of) the identity matrix -* before applying U. -* = 'N': No initialization. Apply U to the input matrix A. -* -* INIT = 'I' may be used to generate square or rectangular -* orthogonal matrices: -* -* For M = N and SIDE = 'L' or 'R', the rows will be orthogonal -* to each other, as will the columns. -* -* If M < N, SIDE = 'R' produces a dense matrix whose rows are -* orthogonal and whose columns are not, while SIDE = 'L' -* produces a matrix whose rows are orthogonal, and whose first -* M columns are orthogonal, and whose remaining columns are -* zero. -* -* If M > N, SIDE = 'L' produces a dense matrix whose columns -* are orthogonal and whose rows are not, while SIDE = 'R' -* produces a matrix whose columns are orthogonal, and whose -* first M rows are orthogonal, and whose remaining rows are -* zero. -* -* M (input) INTEGER -* The number of rows of A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) -* On entry, the array A. -* On exit, overwritten by U A ( if SIDE = 'L' ), -* or by A U ( if SIDE = 'R' ), -* or by U A U' ( if SIDE = 'C' or 'T'). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry ISEED specifies the seed of the random number -* generator. The array elements should be between 0 and 4095; -* if not they will be reduced mod 4096. Also, ISEED(4) must -* be odd. The random number generator uses a linear -* congruential sequence limited to small integers, and so -* should produce machine independent random numbers. The -* values of ISEED are changed on exit, and can be used in the -* next call to DLAROR to continue the same random number -* sequence. -* -* X (workspace) DOUBLE PRECISION array, dimension (3*MAX( M, N )) -* Workspace of length -* 2*M + N if SIDE = 'L', -* 2*N + M if SIDE = 'R', -* 3*N if SIDE = 'C' or 'T'. -* -* INFO (output) INTEGER -* An error flag. It is set to: -* = 0: normal return -* < 0: if INFO = -k, the k-th argument had an illegal value -* = 1: if the random numbers generated by DLARND are bad. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TOOSML - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, - $ TOOSML = 1.0D-20 ) -* .. -* .. Local Scalars .. - INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM - DOUBLE PRECISION FACTOR, XNORM, XNORMS -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLARND, DNRM2 - EXTERNAL LSAME, DLARND, DNRM2 -* .. -* .. External Subroutines .. - EXTERNAL DGEMV, DGER, DLASET, DSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, SIGN -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* - ITYPE = 0 - IF( LSAME( SIDE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( SIDE, 'R' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( SIDE, 'C' ) .OR. LSAME( SIDE, 'T' ) ) THEN - ITYPE = 3 - END IF -* -* Check for argument errors. -* - INFO = 0 - IF( ITYPE.EQ.0 ) THEN - INFO = -1 - ELSE IF( M.LT.0 ) THEN - INFO = -3 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN - INFO = -4 - ELSE IF( LDA.LT.M ) THEN - INFO = -6 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLAROR', -INFO ) - RETURN - END IF -* - IF( ITYPE.EQ.1 ) THEN - NXFRM = M - ELSE - NXFRM = N - END IF -* -* Initialize A to the identity matrix if desired -* - IF( LSAME( INIT, 'I' ) ) - $ CALL DLASET( 'Full', M, N, ZERO, ONE, A, LDA ) -* -* If no rotation possible, multiply by random +/-1 -* -* Compute rotation by computing Householder transformations -* H(2), H(3), ..., H(nhouse) -* - DO 10 J = 1, NXFRM - X( J ) = ZERO - 10 CONTINUE -* - DO 30 IXFRM = 2, NXFRM - KBEG = NXFRM - IXFRM + 1 -* -* Generate independent normal( 0, 1 ) random numbers -* - DO 20 J = KBEG, NXFRM - X( J ) = DLARND( 3, ISEED ) - 20 CONTINUE -* -* Generate a Householder transformation from the random vector X -* - XNORM = DNRM2( IXFRM, X( KBEG ), 1 ) - XNORMS = SIGN( XNORM, X( KBEG ) ) - X( KBEG+NXFRM ) = SIGN( ONE, -X( KBEG ) ) - FACTOR = XNORMS*( XNORMS+X( KBEG ) ) - IF( ABS( FACTOR ).LT.TOOSML ) THEN - INFO = 1 - CALL XERBLA( 'DLAROR', INFO ) - RETURN - ELSE - FACTOR = ONE / FACTOR - END IF - X( KBEG ) = X( KBEG ) + XNORMS -* -* Apply Householder transformation to A -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN -* -* Apply H(k) from the left. -* - CALL DGEMV( 'T', IXFRM, N, ONE, A( KBEG, 1 ), LDA, - $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 ) - CALL DGER( IXFRM, N, -FACTOR, X( KBEG ), 1, X( 2*NXFRM+1 ), - $ 1, A( KBEG, 1 ), LDA ) -* - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN -* -* Apply H(k) from the right. -* - CALL DGEMV( 'N', M, IXFRM, ONE, A( 1, KBEG ), LDA, - $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 ) - CALL DGER( M, IXFRM, -FACTOR, X( 2*NXFRM+1 ), 1, X( KBEG ), - $ 1, A( 1, KBEG ), LDA ) -* - END IF - 30 CONTINUE -* - X( 2*NXFRM ) = SIGN( ONE, DLARND( 3, ISEED ) ) -* -* Scale the matrix A by D. -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN - DO 40 IROW = 1, M - CALL DSCAL( N, X( NXFRM+IROW ), A( IROW, 1 ), LDA ) - 40 CONTINUE - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN - DO 50 JCOL = 1, N - CALL DSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 ) - 50 CONTINUE - END IF - RETURN -* -* End of DLAROR -* - END diff --git a/testing/lin/dlarot.f b/testing/lin/dlarot.f deleted file mode 100644 index e17632ee76d26878ec42c8adec12d854f4b636a8..0000000000000000000000000000000000000000 --- a/testing/lin/dlarot.f +++ /dev/null @@ -1,312 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, - $ XRIGHT ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL LLEFT, LRIGHT, LROWS - INTEGER LDA, NL - DOUBLE PRECISION C, S, XLEFT, XRIGHT -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( * ) -* .. -* -* Purpose -* ======= -* -* DLAROT applies a (Givens) rotation to two adjacent rows or -* columns, where one element of the first and/or last column/row -* for use on matrices stored in some format other than GE, so -* that elements of the matrix may be used or modified for which -* no array element is provided. -* -* One example is a symmetric matrix in SB format (bandwidth=4), for -* which UPLO='L': Two adjacent rows will have the format: -* -* row j: * * * * * . . . . -* row j+1: * * * * * . . . . -* -* '*' indicates elements for which storage is provided, -* '.' indicates elements for which no storage is provided, but -* are not necessarily zero; their values are determined by -* symmetry. ' ' indicates elements which are necessarily zero, -* and have no storage provided. -* -* Those columns which have two '*'s can be handled by DROT. -* Those columns which have no '*'s can be ignored, since as long -* as the Givens rotations are carefully applied to preserve -* symmetry, their values are determined. -* Those columns which have one '*' have to be handled separately, -* by using separate variables "p" and "q": -* -* row j: * * * * * p . . . -* row j+1: q * * * * * . . . . -* -* The element p would have to be set correctly, then that column -* is rotated, setting p to its new value. The next call to -* DLAROT would rotate columns j and j+1, using p, and restore -* symmetry. The element q would start out being zero, and be -* made non-zero by the rotation. Later, rotations would presumably -* be chosen to zero q out. -* -* Typical Calling Sequences: rotating the i-th and (i+1)-st rows. -* ------- ------- --------- -* -* General dense matrix: -* -* CALL DLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, -* A(i,1),LDA, DUMMY, DUMMY) -* -* General banded matrix in GB format: -* -* j = MAX(1, i-KL ) -* NL = MIN( N, i+KU+1 ) + 1-j -* CALL DLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, -* A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,KL+1) ] -* -* Symmetric banded matrix in SY format, bandwidth K, -* lower triangle only: -* -* j = MAX(1, i-K ) -* NL = MIN( K+1, i ) + 1 -* CALL DLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, -* A(i,j), LDA, XLEFT, XRIGHT ) -* -* Same, but upper triangle only: -* -* NL = MIN( K+1, N-i ) + 1 -* CALL DLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, -* A(i,i), LDA, XLEFT, XRIGHT ) -* -* Symmetric banded matrix in SB format, bandwidth K, -* lower triangle only: -* -* [ same as for SY, except:] -* . . . . -* A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,K+1) ] -* -* Same, but upper triangle only: -* . . . -* A(K+1,i), LDA-1, XLEFT, XRIGHT ) -* -* Rotating columns is just the transpose of rotating rows, except -* for GB and SB: (rotating columns i and i+1) -* -* GB: -* j = MAX(1, i-KU ) -* NL = MIN( N, i+KL+1 ) + 1-j -* CALL DLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, -* A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* [note that KU+j+1-i is just MAX(1,KU+2-i)] -* -* SB: (upper triangle) -* -* . . . . . . -* A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* SB: (lower triangle) -* -* . . . . . . -* A(1,i),LDA-1, XTOP, XBOTTM ) -* -* Arguments -* ========= -* -* LROWS - LOGICAL -* If .TRUE., then DLAROT will rotate two rows. If .FALSE., -* then it will rotate two columns. -* Not modified. -* -* LLEFT - LOGICAL -* If .TRUE., then XLEFT will be used instead of the -* corresponding element of A for the first element in the -* second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) -* If .FALSE., then the corresponding element of A will be -* used. -* Not modified. -* -* LRIGHT - LOGICAL -* If .TRUE., then XRIGHT will be used instead of the -* corresponding element of A for the last element in the -* first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If -* .FALSE., then the corresponding element of A will be used. -* Not modified. -* -* NL - INTEGER -* The length of the rows (if LROWS=.TRUE.) or columns (if -* LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are -* used, the columns/rows they are in should be included in -* NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at -* least 2. The number of rows/columns to be rotated -* exclusive of those involving XLEFT and/or XRIGHT may -* not be negative, i.e., NL minus how many of LLEFT and -* LRIGHT are .TRUE. must be at least zero; if not, XERBLA -* will be called. -* Not modified. -* -* C, S - DOUBLE PRECISION -* Specify the Givens rotation to be applied. If LROWS is -* true, then the matrix ( c s ) -* (-s c ) is applied from the left; -* if false, then the transpose thereof is applied from the -* right. For a Givens rotation, C**2 + S**2 should be 1, -* but this is not checked. -* Not modified. -* -* A - DOUBLE PRECISION array. -* The array containing the rows/columns to be rotated. The -* first element of A should be the upper left element to -* be rotated. -* Read and modified. -* -* LDA - INTEGER -* The "effective" leading dimension of A. If A contains -* a matrix stored in GE or SY format, then this is just -* the leading dimension of A as dimensioned in the calling -* routine. If A contains a matrix stored in band (GB or SB) -* format, then this should be *one less* than the leading -* dimension used in the calling routine. Thus, if -* A were dimensioned A(LDA,*) in DLAROT, then A(1,j) would -* be the j-th element in the first of the two rows -* to be rotated, and A(2,j) would be the j-th in the second, -* regardless of how the array may be stored in the calling -* routine. [A cannot, however, actually be dimensioned thus, -* since for band format, the row number may exceed LDA, which -* is not legal FORTRAN.] -* If LROWS=.TRUE., then LDA must be at least 1, otherwise -* it must be at least NL minus the number of .TRUE. values -* in XLEFT and XRIGHT. -* Not modified. -* -* XLEFT - DOUBLE PRECISION -* If LLEFT is .TRUE., then XLEFT will be used and modified -* instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) -* (if LROWS=.FALSE.). -* Read and modified. -* -* XRIGHT - DOUBLE PRECISION -* If LRIGHT is .TRUE., then XRIGHT will be used and modified -* instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) -* (if LROWS=.FALSE.). -* Read and modified. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER IINC, INEXT, IX, IY, IYT, NT -* .. -* .. Local Arrays .. - DOUBLE PRECISION XT( 2 ), YT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL DROT, XERBLA -* .. -* .. Executable Statements .. -* -* Set up indices, arrays for ends -* - IF( LROWS ) THEN - IINC = LDA - INEXT = 1 - ELSE - IINC = 1 - INEXT = LDA - END IF -* - IF( LLEFT ) THEN - NT = 1 - IX = 1 + IINC - IY = 2 + LDA - XT( 1 ) = A( 1 ) - YT( 1 ) = XLEFT - ELSE - NT = 0 - IX = 1 - IY = 1 + INEXT - END IF -* - IF( LRIGHT ) THEN - IYT = 1 + INEXT + ( NL-1 )*IINC - NT = NT + 1 - XT( NT ) = XRIGHT - YT( NT ) = A( IYT ) - END IF -* -* Check for errors -* - IF( NL.LT.NT ) THEN - CALL XERBLA( 'DLAROT', 4 ) - RETURN - END IF - IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN - CALL XERBLA( 'DLAROT', 8 ) - RETURN - END IF -* -* Rotate -* - CALL DROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S ) - CALL DROT( NT, XT, 1, YT, 1, C, S ) -* -* Stuff values back into XLEFT, XRIGHT, etc. -* - IF( LLEFT ) THEN - A( 1 ) = XT( 1 ) - XLEFT = YT( 1 ) - END IF -* - IF( LRIGHT ) THEN - XRIGHT = XT( NT ) - A( IYT ) = YT( NT ) - END IF -* - RETURN -* -* End of DLAROT -* - END diff --git a/testing/lin/dlartg.f b/testing/lin/dlartg.f deleted file mode 100644 index f2e872fa0a813a40afeb81146734bcaac6135468..0000000000000000000000000000000000000000 --- a/testing/lin/dlartg.f +++ /dev/null @@ -1,182 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - DOUBLE PRECISION CS, F, G, R, SN -* .. -* -* Purpose -* ======= -* -* DLARTG generate a plane rotation so that -* -* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. -* [ -SN CS ] [ G ] [ 0 ] -* -* This is a slower, more accurate version of the BLAS1 routine DROTG, -* with the following other differences: -* F and G are unchanged on return. -* If G=0, then CS=1 and SN=0. -* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any -* floating point operations (saves work in DBDSQR when -* there are zeros on the diagonal). -* -* If F exceeds G in magnitude, CS will be positive. -* -* Arguments -* ========= -* -* F (input) DOUBLE PRECISION -* The first component of vector to be rotated. -* -* G (input) DOUBLE PRECISION -* The second component of vector to be rotated. -* -* CS (output) DOUBLE PRECISION -* The cosine of the rotation. -* -* SN (output) DOUBLE PRECISION -* The sine of the rotation. -* -* R (output) DOUBLE PRECISION -* The nonzero component of the rotated vector. -* -* This version has a few statements commented out for thread safety -* (machine parameters are computed on each entry). 10 feb 03, SJH. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D0 ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, INT, LOG, MAX, SQRT -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = DLAMCH( 'S' ) - EPS = DLAMCH( 'E' ) - SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( DLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - IF( G.EQ.ZERO ) THEN - CS = ONE - SN = ZERO - R = F - ELSE IF( F.EQ.ZERO ) THEN - CS = ZERO - SN = ONE - R = G - ELSE - F1 = F - G1 = G - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) THEN - COUNT = 0 - 10 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMN2 - G1 = G1*SAFMN2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) - $ GO TO 10 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 20 I = 1, COUNT - R = R*SAFMX2 - 20 CONTINUE - ELSE IF( SCALE.LE.SAFMN2 ) THEN - COUNT = 0 - 30 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMX2 - G1 = G1*SAFMX2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.LE.SAFMN2 ) - $ GO TO 30 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 40 I = 1, COUNT - R = R*SAFMN2 - 40 CONTINUE - ELSE - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - END IF - IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN - CS = -CS - SN = -SN - R = -R - END IF - END IF - RETURN -* -* End of DLARTG -* - END diff --git a/testing/lin/dlascl.f b/testing/lin/dlascl.f deleted file mode 100644 index e4ba747b8627e2c1fbcdbfc1bd65aaae09a85af5..0000000000000000000000000000000000000000 --- a/testing/lin/dlascl.f +++ /dev/null @@ -1,320 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TYPE - INTEGER INFO, KL, KU, LDA, M, N - DOUBLE PRECISION CFROM, CTO -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DLASCL multiplies the M by N real matrix A by the real scalar -* CTO/CFROM. This is done without over/underflow as long as the final -* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that -* A may be full, upper triangular, lower triangular, upper Hessenberg, -* or banded. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*1 -* TYPE indices the storage type of the input matrix. -* = 'G': A is a full matrix. -* = 'L': A is a lower triangular matrix. -* = 'U': A is an upper triangular matrix. -* = 'H': A is an upper Hessenberg matrix. -* = 'B': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the lower -* half stored. -* = 'Q': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the upper -* half stored. -* = 'Z': A is a band matrix with lower bandwidth KL and upper -* bandwidth KU. -* -* KL (input) INTEGER -* The lower bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* KU (input) INTEGER -* The upper bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* CFROM (input) DOUBLE PRECISION -* CTO (input) DOUBLE PRECISION -* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed -* without over/underflow if the final result CTO*A(I,J)/CFROM -* can be represented without over/underflow. CFROM must be -* nonzero. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* The matrix to be multiplied by CTO/CFROM. See TYPE for the -* storage type. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* INFO (output) INTEGER -* 0 - successful exit -* <0 - if INFO = -i, the i-th argument had an illegal value. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - INTEGER I, ITYPE, J, K1, K2, K3, K4 - DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME, DISNAN - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH, DISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 -* - IF( LSAME( TYPE, 'G' ) ) THEN - ITYPE = 0 - ELSE IF( LSAME( TYPE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( TYPE, 'U' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( TYPE, 'H' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( TYPE, 'B' ) ) THEN - ITYPE = 4 - ELSE IF( LSAME( TYPE, 'Q' ) ) THEN - ITYPE = 5 - ELSE IF( LSAME( TYPE, 'Z' ) ) THEN - ITYPE = 6 - ELSE - ITYPE = -1 - END IF -* - IF( ITYPE.EQ.-1 ) THEN - INFO = -1 - ELSE IF( CFROM.EQ.ZERO .OR. DISNAN(CFROM) ) THEN - INFO = -4 - ELSE IF( DISNAN(CTO) ) THEN - INFO = -5 - ELSE IF( M.LT.0 ) THEN - INFO = -6 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR. - $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN - INFO = -7 - ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN - INFO = -9 - ELSE IF( ITYPE.GE.4 ) THEN - IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN - INFO = -2 - ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR. - $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) ) - $ THEN - INFO = -3 - ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR. - $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR. - $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN - INFO = -9 - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLASCL', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* - CFROMC = CFROM - CTOC = CTO -* - 10 CONTINUE - CFROM1 = CFROMC*SMLNUM - IF( CFROM1.EQ.CFROMC ) THEN -! CFROMC is an inf. Multiply by a correctly signed zero for -! finite CTOC, or a NaN if CTOC is infinite. - MUL = CTOC / CFROMC - DONE = .TRUE. - CTO1 = CTOC - ELSE - CTO1 = CTOC / BIGNUM - IF( CTO1.EQ.CTOC ) THEN -! CTOC is either 0 or an inf. In both cases, CTOC itself -! serves as the correct multiplication factor. - MUL = CTOC - DONE = .TRUE. - CFROMC = ONE - ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN - MUL = SMLNUM - DONE = .FALSE. - CFROMC = CFROM1 - ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN - MUL = BIGNUM - DONE = .FALSE. - CTOC = CTO1 - ELSE - MUL = CTOC / CFROMC - DONE = .TRUE. - END IF - END IF -* - IF( ITYPE.EQ.0 ) THEN -* -* Full matrix -* - DO 30 J = 1, N - DO 20 I = 1, M - A( I, J ) = A( I, J )*MUL - 20 CONTINUE - 30 CONTINUE -* - ELSE IF( ITYPE.EQ.1 ) THEN -* -* Lower triangular matrix -* - DO 50 J = 1, N - DO 40 I = J, M - A( I, J ) = A( I, J )*MUL - 40 CONTINUE - 50 CONTINUE -* - ELSE IF( ITYPE.EQ.2 ) THEN -* -* Upper triangular matrix -* - DO 70 J = 1, N - DO 60 I = 1, MIN( J, M ) - A( I, J ) = A( I, J )*MUL - 60 CONTINUE - 70 CONTINUE -* - ELSE IF( ITYPE.EQ.3 ) THEN -* -* Upper Hessenberg matrix -* - DO 90 J = 1, N - DO 80 I = 1, MIN( J+1, M ) - A( I, J ) = A( I, J )*MUL - 80 CONTINUE - 90 CONTINUE -* - ELSE IF( ITYPE.EQ.4 ) THEN -* -* Lower half of a symmetric band matrix -* - K3 = KL + 1 - K4 = N + 1 - DO 110 J = 1, N - DO 100 I = 1, MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 100 CONTINUE - 110 CONTINUE -* - ELSE IF( ITYPE.EQ.5 ) THEN -* -* Upper half of a symmetric band matrix -* - K1 = KU + 2 - K3 = KU + 1 - DO 130 J = 1, N - DO 120 I = MAX( K1-J, 1 ), K3 - A( I, J ) = A( I, J )*MUL - 120 CONTINUE - 130 CONTINUE -* - ELSE IF( ITYPE.EQ.6 ) THEN -* -* Band matrix -* - K1 = KL + KU + 2 - K2 = KL + 1 - K3 = 2*KL + KU + 1 - K4 = KL + KU + 1 + M - DO 150 J = 1, N - DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 140 CONTINUE - 150 CONTINUE -* - END IF -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of DLASCL -* - END diff --git a/testing/lin/dlaset.f b/testing/lin/dlaset.f deleted file mode 100644 index 815ae13cec8b94aef7a8cb6aee648131a975878d..0000000000000000000000000000000000000000 --- a/testing/lin/dlaset.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, M, N - DOUBLE PRECISION ALPHA, BETA -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DLASET initializes an m-by-n matrix A to BETA on the diagonal and -* ALPHA on the offdiagonals. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies the part of the matrix A to be set. -* = 'U': Upper triangular part is set; the strictly lower -* triangular part of A is not changed. -* = 'L': Lower triangular part is set; the strictly upper -* triangular part of A is not changed. -* Otherwise: All of the matrix A is set. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* ALPHA (input) DOUBLE PRECISION -* The constant to which the offdiagonal elements are to be set. -* -* BETA (input) DOUBLE PRECISION -* The constant to which the diagonal elements are to be set. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On exit, the leading m-by-n submatrix of A is set as follows: -* -* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, -* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, -* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, -* -* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, J -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC MIN -* .. -* .. Executable Statements .. -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Set the strictly upper triangular or trapezoidal part of the -* array to ALPHA. -* - DO 20 J = 2, N - DO 10 I = 1, MIN( J-1, M ) - A( I, J ) = ALPHA - 10 CONTINUE - 20 CONTINUE -* - ELSE IF( LSAME( UPLO, 'L' ) ) THEN -* -* Set the strictly lower triangular or trapezoidal part of the -* array to ALPHA. -* - DO 40 J = 1, MIN( M, N ) - DO 30 I = J + 1, M - A( I, J ) = ALPHA - 30 CONTINUE - 40 CONTINUE -* - ELSE -* -* Set the leading m-by-n submatrix to ALPHA. -* - DO 60 J = 1, N - DO 50 I = 1, M - A( I, J ) = ALPHA - 50 CONTINUE - 60 CONTINUE - END IF -* -* Set the first min(M,N) diagonal elements to BETA. -* - DO 70 I = 1, MIN( M, N ) - A( I, I ) = BETA - 70 CONTINUE -* - RETURN -* -* End of DLASET -* - END diff --git a/testing/lin/dlatb4.f b/testing/lin/dlatb4.f deleted file mode 100644 index 308376d41c1ba11889101f80738c3f589a38fe60..0000000000000000000000000000000000000000 --- a/testing/lin/dlatb4.f +++ /dev/null @@ -1,477 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER IMAT, KL, KU, M, MODE, N - DOUBLE PRECISION ANORM, CNDNUM -* .. -* -* Purpose -* ======= -* -* DLATB4 sets parameters for the matrix generator based on the type of -* matrix to be generated. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name. -* -* IMAT (input) INTEGER -* An integer key describing which matrix to generate for this -* path. -* -* M (input) INTEGER -* The number of rows in the matrix to be generated. -* -* N (input) INTEGER -* The number of columns in the matrix to be generated. -* -* TYPE (output) CHARACTER*1 -* The type of the matrix to be generated: -* = 'S': symmetric matrix -* = 'P': symmetric positive (semi)definite matrix -* = 'N': nonsymmetric matrix -* -* KL (output) INTEGER -* The lower band width of the matrix to be generated. -* -* KU (output) INTEGER -* The upper band width of the matrix to be generated. -* -* ANORM (output) DOUBLE PRECISION -* The desired norm of the matrix to be generated. The diagonal -* matrix of singular values or eigenvalues is scaled by this -* value. -* -* MODE (output) INTEGER -* A key indicating how to choose the vector of eigenvalues. -* -* CNDNUM (output) DOUBLE PRECISION -* The desired condition number. -* -* DIST (output) CHARACTER*1 -* The type of distribution to be used by the random number -* generator. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION SHRINK, TENTH - PARAMETER ( SHRINK = 0.25D0, TENTH = 0.1D+0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL FIRST - CHARACTER*2 C2 - INTEGER MAT - DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAMEN - DOUBLE PRECISION DLAMCH - EXTERNAL LSAMEN, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT -* .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. -* .. Save statement .. - SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST -* .. -* .. Data statements .. - DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* Set some constants for use in the subroutine. -* - IF( FIRST ) THEN - FIRST = .FALSE. - EPS = DLAMCH( 'Precision' ) - BADC2 = TENTH / EPS - BADC1 = SQRT( BADC2 ) - SMALL = DLAMCH( 'Safe minimum' ) - LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) - SMALL = SHRINK*( SMALL / EPS ) - LARGE = ONE / SMALL - END IF -* - C2 = PATH( 2: 3 ) -* -* Set some parameters we don't plan to change. -* - DIST = 'S' - MODE = 3 -* - IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR. - $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* xQR, xLQ, xQL, xRQ: Set parameters to generate a general -* M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* xGE: Set parameters to generate a general M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.10 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.11 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* xGB: Set parameters to generate a general banded matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = TENTH*BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN -* -* xGT: Set parameters to generate a general tridiagonal matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) .OR. - $ LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* xPO, xPP, xSY, xSP: Set parameters to generate a -* symmetric matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = C2( 1: 1 ) -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = MAX( N-1, 0 ) - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.7 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.8 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.9 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* xPB: Set parameters to generate a symmetric band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'P' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN -* -* xPT: Set parameters to generate a symmetric positive definite -* tridiagonal matrix. -* - TYPE = 'P' - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN -* -* xTR, xTP: Set parameters to generate a triangular matrix -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - MAT = ABS( IMAT ) - IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.LT.0 ) THEN - KL = MAX( N-1, 0 ) - KU = 0 - ELSE - KL = 0 - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN - CNDNUM = BADC1 - ELSE IF( MAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE IF( MAT.EQ.10 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( MAT.EQ.5 ) THEN - ANORM = SMALL - ELSE IF( MAT.EQ.6 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* xTB: Set parameters to generate a triangular band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.2 .OR. IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.3 .OR. IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.4 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.5 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF - END IF - IF( N.LE.1 ) - $ CNDNUM = ONE -* - RETURN -* -* End of DLATB4 -* - END diff --git a/testing/lin/dlatm1.f b/testing/lin/dlatm1.f deleted file mode 100644 index d8ffc6f39d2c6d8ad69212ad87cf57666a6bf271..0000000000000000000000000000000000000000 --- a/testing/lin/dlatm1.f +++ /dev/null @@ -1,273 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST, INFO, IRSIGN, MODE, N - DOUBLE PRECISION COND -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION D( * ) -* .. -* -* Purpose -* ======= -* -* DLATM1 computes the entries of D(1..N) as specified by -* MODE, COND and IRSIGN. IDIST and ISEED determine the generation -* of random numbers. DLATM1 is called by SLATMR to generate -* random test matrices for LAPACK programs. -* -* Arguments -* ========= -* -* MODE - INTEGER -* On entry describes how D is to be computed: -* MODE = 0 means do not change D. -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* Not modified. -* -* COND - DOUBLE PRECISION -* On entry, used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* IRSIGN - INTEGER -* On entry, if MODE neither -6, 0 nor 6, determines sign of -* entries of D -* 0 => leave entries of D unchanged -* 1 => multiply each entry of D by 1 or -1 with probability .5 -* -* IDIST - CHARACTER*1 -* On entry, IDIST specifies the type of distribution to be -* used to generate a random matrix . -* 1 => UNIFORM( 0, 1 ) -* 2 => UNIFORM( -1, 1 ) -* 3 => NORMAL( 0, 1 ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The random number generator uses a -* linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to DLATM1 -* to continue the same random number sequence. -* Changed on exit. -* -* D - DOUBLE PRECISION array, dimension ( MIN( M , N ) ) -* Array to be computed according to MODE, COND and IRSIGN. -* May be changed on exit if MODE is nonzero. -* -* N - INTEGER -* Number of entries of D. Not modified. -* -* INFO - INTEGER -* 0 => normal termination -* -1 => if MODE not in range -6 to 6 -* -2 => if MODE neither -6, 0 nor 6, and -* IRSIGN neither 0 nor 1 -* -3 => if MODE neither -6, 0 nor 6 and COND less than 1 -* -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3 -* -7 => if N negative -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) - DOUBLE PRECISION HALF - PARAMETER ( HALF = 0.5D0 ) -* .. -* .. Local Scalars .. - INTEGER I - DOUBLE PRECISION ALPHA, TEMP -* .. -* .. External Functions .. - DOUBLE PRECISION DLARAN - EXTERNAL DLARAN -* .. -* .. External Subroutines .. - EXTERNAL DLARNV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, EXP, LOG -* .. -* .. Executable Statements .. -* -* Decode and Test the input parameters. Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Set INFO if an error -* - IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN - INFO = -1 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN - INFO = -2 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ COND.LT.ONE ) THEN - INFO = -3 - ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND. - $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -7 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLATM1', -INFO ) - RETURN - END IF -* -* Compute D according to COND and MODE -* - IF( MODE.NE.0 ) THEN - GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE ) -* -* One large D value: -* - 10 CONTINUE - DO 20 I = 1, N - D( I ) = ONE / COND - 20 CONTINUE - D( 1 ) = ONE - GO TO 120 -* -* One small D value: -* - 30 CONTINUE - DO 40 I = 1, N - D( I ) = ONE - 40 CONTINUE - D( N ) = ONE / COND - GO TO 120 -* -* Exponentially distributed D values: -* - 50 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - ALPHA = COND**( -ONE / DBLE( N-1 ) ) - DO 60 I = 2, N - D( I ) = ALPHA**( I-1 ) - 60 CONTINUE - END IF - GO TO 120 -* -* Arithmetically distributed D values: -* - 70 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - TEMP = ONE / COND - ALPHA = ( ONE-TEMP ) / DBLE( N-1 ) - DO 80 I = 2, N - D( I ) = DBLE( N-I )*ALPHA + TEMP - 80 CONTINUE - END IF - GO TO 120 -* -* Randomly distributed D values on ( 1/COND , 1): -* - 90 CONTINUE - ALPHA = LOG( ONE / COND ) - DO 100 I = 1, N - D( I ) = EXP( ALPHA*DLARAN( ISEED ) ) - 100 CONTINUE - GO TO 120 -* -* Randomly distributed D values from IDIST -* - 110 CONTINUE - CALL DLARNV( IDIST, ISEED, N, D ) -* - 120 CONTINUE -* -* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign -* random signs to D -* - IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ IRSIGN.EQ.1 ) THEN - DO 130 I = 1, N - TEMP = DLARAN( ISEED ) - IF( TEMP.GT.HALF ) - $ D( I ) = -D( I ) - 130 CONTINUE - END IF -* -* Reverse if MODE < 0 -* - IF( MODE.LT.0 ) THEN - DO 140 I = 1, N / 2 - TEMP = D( I ) - D( I ) = D( N+1-I ) - D( N+1-I ) = TEMP - 140 CONTINUE - END IF -* - END IF -* - RETURN -* -* End of DLATM1 -* - END diff --git a/testing/lin/dlatms.f b/testing/lin/dlatms.f deleted file mode 100644 index 3231b87a7b1e1d5496d08767111946d513d05939..0000000000000000000000000000000000000000 --- a/testing/lin/dlatms.f +++ /dev/null @@ -1,1076 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, - $ KL, KU, PACK, A, LDA, WORK, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, PACK, SYM - INTEGER INFO, KL, KU, LDA, M, MODE, N - DOUBLE PRECISION COND, DMAX -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* DLATMS generates random matrices with specified singular values -* (or symmetric/hermitian with specified eigenvalues) -* for testing LAPACK programs. -* -* DLATMS operates by applying the following sequence of -* operations: -* -* Set the diagonal to D, where D may be input or -* computed according to MODE, COND, DMAX, and SYM -* as described below. -* -* Generate a matrix with the appropriate band structure, by one -* of two methods: -* -* Method A: -* Generate a dense M x N matrix by multiplying D on the left -* and the right by random unitary matrices, then: -* -* Reduce the bandwidth according to KL and KU, using -* Householder transformations. -* -* Method B: -* Convert the bandwidth-0 (i.e., diagonal) matrix to a -* bandwidth-1 matrix using Givens rotations, "chasing" -* out-of-band elements back, much as in QR; then -* convert the bandwidth-1 to a bandwidth-2 matrix, etc. -* Note that for reasonably small bandwidths (relative to -* M and N) this requires less storage, as a dense matrix -* is not generated. Also, for symmetric matrices, only -* one triangle is generated. -* -* Method A is chosen if the bandwidth is a large fraction of the -* order of the matrix, and LDA is at least M (so a dense -* matrix can be stored.) Method B is chosen if the bandwidth -* is small (< 1/2 N for symmetric, < .3 N+M for -* non-symmetric), or LDA is less than M and not less than the -* bandwidth. -* -* Pack the matrix if desired. Options specified by PACK are: -* no packing -* zero out upper half (if symmetric) -* zero out lower half (if symmetric) -* store the upper half columnwise (if symmetric or upper -* triangular) -* store the lower half columnwise (if symmetric or lower -* triangular) -* store the lower triangle in banded format (if symmetric -* or lower triangular) -* store the upper triangle in banded format (if symmetric -* or upper triangular) -* store the entire matrix in banded format -* If Method B is chosen, and band format is specified, then the -* matrix will be generated in the band format, so no repacking -* will be necessary. -* -* Arguments -* ========= -* -* M - INTEGER -* The number of rows of A. Not modified. -* -* N - INTEGER -* The number of columns of A. Not modified. -* -* DIST - CHARACTER*1 -* On entry, DIST specifies the type of distribution to be used -* to generate the random eigen-/singular values. -* 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) -* 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) -* 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. They should lie between 0 and 4095 inclusive, -* and ISEED(4) should be odd. The random number generator -* uses a linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to DLATMS -* to continue the same random number sequence. -* Changed on exit. -* -* SYM - CHARACTER*1 -* If SYM='S' or 'H', the generated matrix is symmetric, with -* eigenvalues specified by D, COND, MODE, and DMAX; they -* may be positive, negative, or zero. -* If SYM='P', the generated matrix is symmetric, with -* eigenvalues (= singular values) specified by D, COND, -* MODE, and DMAX; they will not be negative. -* If SYM='N', the generated matrix is nonsymmetric, with -* singular values specified by D, COND, MODE, and DMAX; -* they will not be negative. -* Not modified. -* -* D - DOUBLE PRECISION array, dimension ( MIN( M , N ) ) -* This array is used to specify the singular values or -* eigenvalues of A (see SYM, above.) If MODE=0, then D is -* assumed to contain the singular/eigenvalues, otherwise -* they will be computed according to MODE, COND, and DMAX, -* and placed in D. -* Modified if MODE is nonzero. -* -* MODE - INTEGER -* On entry this describes how the singular/eigenvalues are to -* be specified: -* MODE = 0 means use D as input -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then -* the elements of D will also be multiplied by a random -* sign (i.e., +1 or -1.) -* Not modified. -* -* COND - DOUBLE PRECISION -* On entry, this is used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* DMAX - DOUBLE PRECISION -* If MODE is neither -6, 0 nor 6, the contents of D, as -* computed according to MODE and COND, will be scaled by -* DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or -* singular value (which is to say the norm) will be abs(DMAX). -* Note that DMAX need not be positive: if DMAX is negative -* (or zero), D will be scaled by a negative number (or zero). -* Not modified. -* -* KL - INTEGER -* This specifies the lower bandwidth of the matrix. For -* example, KL=0 implies upper triangular, KL=1 implies upper -* Hessenberg, and KL being at least M-1 means that the matrix -* has full lower bandwidth. KL must equal KU if the matrix -* is symmetric. -* Not modified. -* -* KU - INTEGER -* This specifies the upper bandwidth of the matrix. For -* example, KU=0 implies lower triangular, KU=1 implies lower -* Hessenberg, and KU being at least N-1 means that the matrix -* has full upper bandwidth. KL must equal KU if the matrix -* is symmetric. -* Not modified. -* -* PACK - CHARACTER*1 -* This specifies packing of matrix as follows: -* 'N' => no packing -* 'U' => zero out all subdiagonal entries (if symmetric) -* 'L' => zero out all superdiagonal entries (if symmetric) -* 'C' => store the upper triangle columnwise -* (only if the matrix is symmetric or upper triangular) -* 'R' => store the lower triangle columnwise -* (only if the matrix is symmetric or lower triangular) -* 'B' => store the lower triangle in band storage scheme -* (only if matrix symmetric or lower triangular) -* 'Q' => store the upper triangle in band storage scheme -* (only if matrix symmetric or upper triangular) -* 'Z' => store the entire matrix in band storage scheme -* (pivoting can be provided for by using this -* option to store A in the trailing rows of -* the allocated storage) -* -* Using these options, the various LAPACK packed and banded -* storage schemes can be obtained: -* GB - use 'Z' -* PB, SB or TB - use 'B' or 'Q' -* PP, SP or TP - use 'C' or 'R' -* -* If two calls to DLATMS differ only in the PACK parameter, -* they will generate mathematically equivalent matrices. -* Not modified. -* -* A - DOUBLE PRECISION array, dimension ( LDA, N ) -* On exit A is the desired test matrix. A is first generated -* in full (unpacked) form, and then packed, if so specified -* by PACK. Thus, the first M elements of the first N -* columns will always be modified. If PACK specifies a -* packed or banded storage scheme, all LDA elements of the -* first N columns will be modified; the elements of the -* array which do not correspond to elements of the generated -* matrix are set to zero. -* Modified. -* -* LDA - INTEGER -* LDA specifies the first dimension of A as declared in the -* calling program. If PACK='N', 'U', 'L', 'C', or 'R', then -* LDA must be at least M. If PACK='B' or 'Q', then LDA must -* be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). -* If PACK='Z', LDA must be large enough to hold the packed -* array: MIN( KU, N-1) + MIN( KL, M-1) + 1. -* Not modified. -* -* WORK - DOUBLE PRECISION array, dimension ( 3*MAX( N , M ) ) -* Workspace. -* Modified. -* -* INFO - INTEGER -* Error code. On exit, INFO will be set to one of the -* following values: -* 0 => normal return -* -1 => M negative or unequal to N and SYM='S', 'H', or 'P' -* -2 => N negative -* -3 => DIST illegal string -* -5 => SYM illegal string -* -7 => MODE not in range -6 to 6 -* -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 -* -10 => KL negative -* -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL -* -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; -* or PACK='C' or 'Q' and SYM='N' and KL is not zero; -* or PACK='R' or 'B' and SYM='N' and KU is not zero; -* or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not -* N. -* -14 => LDA is less than M, or PACK='Z' and LDA is less than -* MIN(KU,N-1) + MIN(KL,M-1) + 1. -* 1 => Error return from DLATM1 -* 2 => Cannot scale to DMAX (max. sing. value is 0) -* 3 => Error return from DLAGGE or SLAGSY -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) - DOUBLE PRECISION TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 ) -* .. -* .. Local Scalars .. - LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN - INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA, - $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2, - $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH, - $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC, - $ UUB - DOUBLE PRECISION ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLARND - EXTERNAL LSAME, DLARND -* .. -* .. External Subroutines .. - EXTERNAL DCOPY, DLAGGE, DLAGSY, DLAROT, DLARTG, DLASET, - $ DLATM1, DSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, COS, DBLE, MAX, MIN, MOD, SIN -* .. -* .. Executable Statements .. -* -* 1) Decode and Test the input parameters. -* Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN -* -* Decode DIST -* - IF( LSAME( DIST, 'U' ) ) THEN - IDIST = 1 - ELSE IF( LSAME( DIST, 'S' ) ) THEN - IDIST = 2 - ELSE IF( LSAME( DIST, 'N' ) ) THEN - IDIST = 3 - ELSE - IDIST = -1 - END IF -* -* Decode SYM -* - IF( LSAME( SYM, 'N' ) ) THEN - ISYM = 1 - IRSIGN = 0 - ELSE IF( LSAME( SYM, 'P' ) ) THEN - ISYM = 2 - IRSIGN = 0 - ELSE IF( LSAME( SYM, 'S' ) ) THEN - ISYM = 2 - IRSIGN = 1 - ELSE IF( LSAME( SYM, 'H' ) ) THEN - ISYM = 2 - IRSIGN = 1 - ELSE - ISYM = -1 - END IF -* -* Decode PACK -* - ISYMPK = 0 - IF( LSAME( PACK, 'N' ) ) THEN - IPACK = 0 - ELSE IF( LSAME( PACK, 'U' ) ) THEN - IPACK = 1 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'L' ) ) THEN - IPACK = 2 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'C' ) ) THEN - IPACK = 3 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'R' ) ) THEN - IPACK = 4 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'B' ) ) THEN - IPACK = 5 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'Q' ) ) THEN - IPACK = 6 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'Z' ) ) THEN - IPACK = 7 - ELSE - IPACK = -1 - END IF -* -* Set certain internal parameters -* - MNMIN = MIN( M, N ) - LLB = MIN( KL, M-1 ) - UUB = MIN( KU, N-1 ) - MR = MIN( M, N+LLB ) - NC = MIN( N, M+UUB ) -* - IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN - MINLDA = UUB + 1 - ELSE IF( IPACK.EQ.7 ) THEN - MINLDA = LLB + UUB + 1 - ELSE - MINLDA = M - END IF -* -* Use Givens rotation method if bandwidth small enough, -* or if LDA is too small to store the matrix unpacked. -* - GIVENS = .FALSE. - IF( ISYM.EQ.1 ) THEN - IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) ) - $ GIVENS = .TRUE. - ELSE - IF( 2*LLB.LT.M ) - $ GIVENS = .TRUE. - END IF - IF( LDA.LT.M .AND. LDA.GE.MINLDA ) - $ GIVENS = .TRUE. -* -* Set INFO if an error -* - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( IDIST.EQ.-1 ) THEN - INFO = -3 - ELSE IF( ISYM.EQ.-1 ) THEN - INFO = -5 - ELSE IF( ABS( MODE ).GT.6 ) THEN - INFO = -7 - ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) - $ THEN - INFO = -8 - ELSE IF( KL.LT.0 ) THEN - INFO = -10 - ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN - INFO = -11 - ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR. - $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR. - $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR. - $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN - INFO = -12 - ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN - INFO = -14 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLATMS', -INFO ) - RETURN - END IF -* -* Initialize random number generator -* - DO 10 I = 1, 4 - ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) - 10 CONTINUE -* - IF( MOD( ISEED( 4 ), 2 ).NE.1 ) - $ ISEED( 4 ) = ISEED( 4 ) + 1 -* -* 2) Set up D if indicated. -* -* Compute D according to COND and MODE -* - CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) - IF( IINFO.NE.0 ) THEN - INFO = 1 - RETURN - END IF -* -* Choose Top-Down if D is (apparently) increasing, -* Bottom-Up if D is (apparently) decreasing. -* - IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN - TOPDWN = .TRUE. - ELSE - TOPDWN = .FALSE. - END IF -* - IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN -* -* Scale by DMAX -* - TEMP = ABS( D( 1 ) ) - DO 20 I = 2, MNMIN - TEMP = MAX( TEMP, ABS( D( I ) ) ) - 20 CONTINUE -* - IF( TEMP.GT.ZERO ) THEN - ALPHA = DMAX / TEMP - ELSE - INFO = 2 - RETURN - END IF -* - CALL DSCAL( MNMIN, ALPHA, D, 1 ) -* - END IF -* -* 3) Generate Banded Matrix using Givens rotations. -* Also the special case of UUB=LLB=0 -* -* Compute Addressing constants to cover all -* storage formats. Whether GE, SY, GB, or SB, -* upper or lower triangle or both, -* the (i,j)-th element is in -* A( i - ISKEW*j + IOFFST, j ) -* - IF( IPACK.GT.4 ) THEN - ILDA = LDA - 1 - ISKEW = 1 - IF( IPACK.GT.5 ) THEN - IOFFST = UUB + 1 - ELSE - IOFFST = 1 - END IF - ELSE - ILDA = LDA - ISKEW = 0 - IOFFST = 0 - END IF -* -* IPACKG is the format that the matrix is generated in. If this is -* different from IPACK, then the matrix must be repacked at the -* end. It also signals how to compute the norm, for scaling. -* - IPACKG = 0 - CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) -* -* Diagonal Matrix -- We are done, unless it -* is to be stored SP/PP/TP (PACK='R' or 'C') -* - IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN - CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) - IF( IPACK.LE.2 .OR. IPACK.GE.5 ) - $ IPACKG = IPACK -* - ELSE IF( GIVENS ) THEN -* -* Check whether to use Givens rotations, -* Householder transformations, or nothing. -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - IF( IPACK.GT.4 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF -* - CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) -* - IF( TOPDWN ) THEN - JKL = 0 - DO 50 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* Last row actually rotated is M -* Last column actually rotated is MIN( M+JKU, N ) -* - DO 40 JR = 1, MIN( M+JKU, N ) + JKL - 1 - EXTRA = ZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - ICOL = MAX( 1, JR-JKL ) - IF( JR.LT.M ) THEN - IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, - $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IR = JR - IC = ICOL - DO 30 JCH = JR - JKL, 1, -JKL - JKU - IF( IR.LT.M ) THEN - CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, C, S, DUMMY ) - END IF - IROW = MAX( 1, JCH-JKU ) - IL = IR + 2 - IROW - TEMP = ZERO - ILTEMP = JCH.GT.JKU - CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, - $ A( IROW-ISKEW*IC+IOFFST, IC ), - $ ILDA, TEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL DLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), TEMP, C, S, DUMMY ) - ICOL = MAX( 1, JCH-JKU-JKL ) - IL = IC + 2 - ICOL - EXTRA = ZERO - CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., - $ IL, C, -S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ TEMP ) - IC = ICOL - IR = IROW - END IF - 30 CONTINUE - 40 CONTINUE - 50 CONTINUE -* - JKU = UUB - DO 80 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* - DO 70 JC = 1, MIN( N+JKL, M ) + JKU - 1 - EXTRA = ZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - IROW = MAX( 1, JC-JKU ) - IF( JC.LT.N ) THEN - IL = MIN( M, JC+JKL ) + 1 - IROW - CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, - $ S, A( IROW-ISKEW*JC+IOFFST, JC ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IC = JC - IR = IROW - DO 60 JCH = JC - JKU, 1, -JKL - JKU - IF( IC.LT.N ) THEN - CALL DLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, C, S, DUMMY ) - END IF - ICOL = MAX( 1, JCH-JKL ) - IL = IC + 2 - ICOL - TEMP = ZERO - ILTEMP = JCH.GT.JKL - CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, - $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, TEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL DLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST, - $ ICOL+1 ), TEMP, C, S, DUMMY ) - IROW = MAX( 1, JCH-JKL-JKU ) - IL = IR + 2 - IROW - EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., - $ IL, C, -S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ TEMP ) - IC = ICOL - IR = IROW - END IF - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* - ELSE -* -* Bottom-Up -- Start at the bottom right. -* - JKL = 0 - DO 110 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* First row actually rotated is M -* First column actually rotated is MIN( M+JKU, N ) -* - IENDCH = MIN( M, N+JKL ) - 1 - DO 100 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1 - EXTRA = ZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - IROW = MAX( 1, JC-JKU+1 ) - IF( JC.GT.0 ) THEN - IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, - $ C, S, A( IROW-ISKEW*JC+IOFFST, - $ JC ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IC = JC - DO 90 JCH = JC + JKL, IENDCH, JKL + JKU - ILEXTR = IC.GT.0 - IF( ILEXTR ) THEN - CALL DLARTG( A( JCH-ISKEW*IC+IOFFST, IC ), - $ EXTRA, C, S, DUMMY ) - END IF - IC = MAX( 1, IC ) - ICOL = MIN( N-1, JCH+JKU ) - ILTEMP = JCH + JKU.LT.N - TEMP = ZERO - CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, - $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), - $ ILDA, EXTRA, TEMP ) - IF( ILTEMP ) THEN - CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), TEMP, C, S, DUMMY ) - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = ZERO - CALL DLAROT( .FALSE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, TEMP, EXTRA ) - IC = ICOL - END IF - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE -* - JKU = UUB - DO 140 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* -* First row actually rotated is MIN( N+JKL, M ) -* First column actually rotated is N -* - IENDCH = MIN( N, M+JKU ) - 1 - DO 130 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1 - EXTRA = ZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - ICOL = MAX( 1, JR-JKL+1 ) - IF( JR.GT.0 ) THEN - IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, - $ C, S, A( JR-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IR = JR - DO 120 JCH = JR + JKU, IENDCH, JKL + JKU - ILEXTR = IR.GT.0 - IF( ILEXTR ) THEN - CALL DLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ), - $ EXTRA, C, S, DUMMY ) - END IF - IR = MAX( 1, IR ) - IROW = MIN( M-1, JCH+JKL ) - ILTEMP = JCH + JKL.LT.M - TEMP = ZERO - CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, - $ C, S, A( IR-ISKEW*JCH+IOFFST, - $ JCH ), ILDA, EXTRA, TEMP ) - IF( ILTEMP ) THEN - CALL DLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ TEMP, C, S, DUMMY ) - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = ZERO - CALL DLAROT( .TRUE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ ILDA, TEMP, EXTRA ) - IR = IROW - END IF - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - END IF -* - ELSE -* -* Symmetric -- A = U D U' -* - IPACKG = IPACK - IOFFG = IOFFST -* - IF( TOPDWN ) THEN -* -* Top-Down -- Generate Upper triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 6 - IOFFG = UUB + 1 - ELSE - IPACKG = 1 - END IF - CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) -* - DO 170 K = 1, UUB - DO 160 JC = 1, N - 1 - IROW = MAX( 1, JC-K ) - IL = MIN( JC+1, K+2 ) - EXTRA = ZERO - TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 ) - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - CALL DLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S, - $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA, - $ EXTRA, TEMP ) - CALL DLAROT( .TRUE., .TRUE., .FALSE., - $ MIN( K, N-JC )+1, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ TEMP, DUMMY ) -* -* Chase EXTRA back up the matrix -* - ICOL = JC - DO 150 JCH = JC - K, 1, -K - CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, - $ ICOL+1 ), EXTRA, C, S, DUMMY ) - TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, - $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, TEMP, EXTRA ) - IROW = MAX( 1, JCH-K ) - IL = MIN( JCH+1, K+2 ) - EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, - $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), - $ ILDA, EXTRA, TEMP ) - ICOL = JCH - 150 CONTINUE - 160 CONTINUE - 170 CONTINUE -* -* If we need lower triangle, copy from upper. Note that -* the order of copying is chosen to work for 'q' -> 'b' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN - DO 190 JC = 1, N - IROW = IOFFST - ISKEW*JC - DO 180 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 180 CONTINUE - 190 CONTINUE - IF( IPACK.EQ.5 ) THEN - DO 210 JC = N - UUB + 1, N - DO 200 JR = N + 2 - JC, UUB + 1 - A( JR, JC ) = ZERO - 200 CONTINUE - 210 CONTINUE - END IF - IF( IPACKG.EQ.6 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - ELSE -* -* Bottom-Up -- Generate Lower triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 5 - IF( IPACK.EQ.6 ) - $ IOFFG = 1 - ELSE - IPACKG = 2 - END IF - CALL DCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) -* - DO 240 K = 1, UUB - DO 230 JC = N - 1, 1, -1 - IL = MIN( N+1-JC, K+2 ) - EXTRA = ZERO - TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC ) - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE ) - S = -SIN( ANGLE ) - CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ TEMP, EXTRA ) - ICOL = MAX( 1, JC-K+1 ) - CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, - $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, DUMMY, TEMP ) -* -* Chase EXTRA back down the matrix -* - ICOL = JC - DO 220 JCH = JC + K, N - 1, K - CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ EXTRA, C, S, DUMMY ) - TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, EXTRA, TEMP ) - IL = MIN( N+1-JCH, K+2 ) - EXTRA = ZERO - CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, - $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, TEMP, EXTRA ) - ICOL = JCH - 220 CONTINUE - 230 CONTINUE - 240 CONTINUE -* -* If we need upper triangle, copy from lower. Note that -* the order of copying is chosen to work for 'b' -> 'q' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN - DO 260 JC = N, 1, -1 - IROW = IOFFST - ISKEW*JC - DO 250 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 250 CONTINUE - 260 CONTINUE - IF( IPACK.EQ.6 ) THEN - DO 280 JC = 1, UUB - DO 270 JR = 1, UUB + 1 - JC - A( JR, JC ) = ZERO - 270 CONTINUE - 280 CONTINUE - END IF - IF( IPACKG.EQ.5 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - END IF - END IF -* - ELSE -* -* 4) Generate Banded Matrix by first -* Rotating by random Unitary matrices, -* then reducing the bandwidth using Householder -* transformations. -* -* Note: we should get here only if LDA .ge. N -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - CALL DLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK, - $ IINFO ) - ELSE -* -* Symmetric -- A = U D U' -* - CALL DLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) -* - END IF - IF( IINFO.NE.0 ) THEN - INFO = 3 - RETURN - END IF - END IF -* -* 5) Pack the matrix -* - IF( IPACK.NE.IPACKG ) THEN - IF( IPACK.EQ.1 ) THEN -* -* 'U' -- Upper triangular, not packed -* - DO 300 J = 1, M - DO 290 I = J + 1, M - A( I, J ) = ZERO - 290 CONTINUE - 300 CONTINUE -* - ELSE IF( IPACK.EQ.2 ) THEN -* -* 'L' -- Lower triangular, not packed -* - DO 320 J = 2, M - DO 310 I = 1, J - 1 - A( I, J ) = ZERO - 310 CONTINUE - 320 CONTINUE -* - ELSE IF( IPACK.EQ.3 ) THEN -* -* 'C' -- Upper triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 340 J = 1, M - DO 330 I = 1, J - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 330 CONTINUE - 340 CONTINUE -* - ELSE IF( IPACK.EQ.4 ) THEN -* -* 'R' -- Lower triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 360 J = 1, M - DO 350 I = J, M - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 350 CONTINUE - 360 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* 'B' -- The lower triangle is packed as a band matrix. -* 'Q' -- The upper triangle is packed as a band matrix. -* 'Z' -- The whole matrix is packed as a band matrix. -* - IF( IPACK.EQ.5 ) - $ UUB = 0 - IF( IPACK.EQ.6 ) - $ LLB = 0 -* - DO 380 J = 1, UUB - DO 370 I = MIN( J+LLB, M ), 1, -1 - A( I-J+UUB+1, J ) = A( I, J ) - 370 CONTINUE - 380 CONTINUE -* - DO 400 J = UUB + 2, N - DO 390 I = J - UUB, MIN( J+LLB, M ) - A( I-J+UUB+1, J ) = A( I, J ) - 390 CONTINUE - 400 CONTINUE - END IF -* -* If packed, zero out extraneous elements. -* -* Symmetric/Triangular Packed -- -* zero out everything after A(IROW,ICOL) -* - IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN - DO 420 JC = ICOL, M - DO 410 JR = IROW + 1, LDA - A( JR, JC ) = ZERO - 410 CONTINUE - IROW = 0 - 420 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* Packed Band -- -* 1st row is now in A( UUB+2-j, j), zero above it -* m-th row is now in A( M+UUB-j,j), zero below it -* last non-zero diagonal is now in A( UUB+LLB+1,j ), -* zero below it, too. -* - IR1 = UUB + LLB + 2 - IR2 = UUB + M + 2 - DO 450 JC = 1, N - DO 430 JR = 1, UUB + 1 - JC - A( JR, JC ) = ZERO - 430 CONTINUE - DO 440 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA - A( JR, JC ) = ZERO - 440 CONTINUE - 450 CONTINUE - END IF - END IF -* - RETURN -* -* End of DLATMS -* - END diff --git a/testing/lin/dlatrs.f b/testing/lin/dlatrs.f deleted file mode 100644 index 5f8a3d3b94095866bcfed05f79707c44af142e75..0000000000000000000000000000000000000000 --- a/testing/lin/dlatrs.f +++ /dev/null @@ -1,738 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, - $ CNORM, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, NORMIN, TRANS, UPLO - INTEGER INFO, LDA, N - DOUBLE PRECISION SCALE -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* DLATRS solves one of the triangular systems -* -* A *x = s*b or A'*x = s*b -* -* with scaling to prevent overflow. Here A is an upper or lower -* triangular matrix, A' denotes the transpose of A, x and b are -* n-element vectors, and s is a scaling factor, usually less than -* or equal to 1, chosen so that the components of x will be less than -* the overflow threshold. If the unscaled problem will not cause -* overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A -* is singular (A(j,j) = 0 for some j), then s is set to 0 and a -* non-trivial solution to A*x = 0 is returned. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to A. -* = 'N': Solve A * x = s*b (No transpose) -* = 'T': Solve A'* x = s*b (Transpose) -* = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose) -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* NORMIN (input) CHARACTER*1 -* Specifies whether CNORM has been set or not. -* = 'Y': CNORM contains the column norms on entry -* = 'N': CNORM is not set on entry. On exit, the norms will -* be computed and stored in CNORM. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The triangular matrix A. If UPLO = 'U', the leading n by n -* upper triangular part of the array A contains the upper -* triangular matrix, and the strictly lower triangular part of -* A is not referenced. If UPLO = 'L', the leading n by n lower -* triangular part of the array A contains the lower triangular -* matrix, and the strictly upper triangular part of A is not -* referenced. If DIAG = 'U', the diagonal elements of A are -* also not referenced and are assumed to be 1. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max (1,N). -* -* X (input/output) DOUBLE PRECISION array, dimension (N) -* On entry, the right hand side b of the triangular system. -* On exit, X is overwritten by the solution vector x. -* -* SCALE (output) DOUBLE PRECISION -* The scaling factor s for the triangular system -* A * x = s*b or A'* x = s*b. -* If SCALE = 0, the matrix A is singular or badly scaled, and -* the vector x is an exact or approximate solution to A*x = 0. -* -* CNORM (input or output) DOUBLE PRECISION array, dimension (N) -* -* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) -* contains the norm of the off-diagonal part of the j-th column -* of A. If TRANS = 'N', CNORM(j) must be greater than or equal -* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) -* must be greater than or equal to the 1-norm. -* -* If NORMIN = 'N', CNORM is an output argument and CNORM(j) -* returns the 1-norm of the offdiagonal part of the j-th column -* of A. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* Further Details -* ======= ======= -* -* A rough bound on x is computed; if that is less than overflow, DTRSV -* is called, otherwise, specific code is used which checks for possible -* overflow or divide-by-zero at every operation. -* -* A columnwise scheme is used for solving A*x = b. The basic algorithm -* if A is lower triangular is -* -* x[1:n] := b[1:n] -* for j = 1, ..., n -* x(j) := x(j) / A(j,j) -* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] -* end -* -* Define bounds on the components of x after j iterations of the loop: -* M(j) = bound on x[1:j] -* G(j) = bound on x[j+1:n] -* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. -* -* Then for iteration j+1 we have -* M(j+1) <= G(j) / | A(j+1,j+1) | -* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | -* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) -* -* where CNORM(j+1) is greater than or equal to the infinity-norm of -* column j+1 of A, not counting the diagonal. Hence -* -* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) -* 1<=i<=j -* and -* -* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) -* 1<=i< j -* -* Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the -* reciprocal of the largest M(j), j=1,..,n, is larger than -* max(underflow, 1/overflow). -* -* The bound on x(j) is also used to determine when a step in the -* columnwise method can be performed without fear of overflow. If -* the computed bound is greater than a large constant, x is scaled to -* prevent overflow, but if the bound overflows, x is set to 0, x(j) to -* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. -* -* Similarly, a row-wise scheme is used to solve A'*x = b. The basic -* algorithm for A upper triangular is -* -* for j = 1, ..., n -* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) -* end -* -* We simultaneously compute two bounds -* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j -* M(j) = bound on x(i), 1<=i<=j -* -* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we -* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. -* Then the bound on x(j) is -* -* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | -* -* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) -* 1<=i<=j -* -* and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater -* than max(underflow, 1/overflow). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, HALF, ONE - PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOTRAN, NOUNIT, UPPER - INTEGER I, IMAX, J, JFIRST, JINC, JLAST - DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, - $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX - DOUBLE PRECISION DASUM, DDOT, DLAMCH - EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOTRAN = LSAME( TRANS, 'N' ) - NOUNIT = LSAME( DIAG, 'N' ) -* -* Test the input parameters. -* - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -3 - ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT. - $ LSAME( NORMIN, 'N' ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -5 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -7 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLATRS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine machine dependent parameters to control overflow. -* - SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - SCALE = ONE -* - IF( LSAME( NORMIN, 'N' ) ) THEN -* -* Compute the 1-norm of each column, not including the diagonal. -* - IF( UPPER ) THEN -* -* A is upper triangular. -* - DO 10 J = 1, N - CNORM( J ) = DASUM( J-1, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* A is lower triangular. -* - DO 20 J = 1, N - 1 - CNORM( J ) = DASUM( N-J, A( J+1, J ), 1 ) - 20 CONTINUE - CNORM( N ) = ZERO - END IF - END IF -* -* Scale the column norms by TSCAL if the maximum element in CNORM is -* greater than BIGNUM. -* - IMAX = IDAMAX( N, CNORM, 1 ) - TMAX = CNORM( IMAX ) - IF( TMAX.LE.BIGNUM ) THEN - TSCAL = ONE - ELSE - TSCAL = ONE / ( SMLNUM*TMAX ) - CALL DSCAL( N, TSCAL, CNORM, 1 ) - END IF -* -* Compute a bound on the computed solution vector to see if the -* Level 2 BLAS routine DTRSV can be used. -* - J = IDAMAX( N, X, 1 ) - XMAX = ABS( X( J ) ) - XBND = XMAX - IF( NOTRAN ) THEN -* -* Compute the growth in A * x = b. -* - IF( UPPER ) THEN - JFIRST = N - JLAST = 1 - JINC = -1 - ELSE - JFIRST = 1 - JLAST = N - JINC = 1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 50 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, G(0) = max{x(i), i=1,...,n}. -* - GROW = ONE / MAX( XBND, SMLNUM ) - XBND = GROW - DO 30 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 50 -* -* M(j) = G(j-1) / abs(A(j,j)) -* - TJJ = ABS( A( J, J ) ) - XBND = MIN( XBND, MIN( ONE, TJJ )*GROW ) - IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN -* -* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) -* - GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) ) - ELSE -* -* G(j) could overflow, set GROW to 0. -* - GROW = ZERO - END IF - 30 CONTINUE - GROW = XBND - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) ) - DO 40 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 50 -* -* G(j) = G(j-1)*( 1 + CNORM(j) ) -* - GROW = GROW*( ONE / ( ONE+CNORM( J ) ) ) - 40 CONTINUE - END IF - 50 CONTINUE -* - ELSE -* -* Compute the growth in A' * x = b. -* - IF( UPPER ) THEN - JFIRST = 1 - JLAST = N - JINC = 1 - ELSE - JFIRST = N - JLAST = 1 - JINC = -1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 80 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, M(0) = max{x(i), i=1,...,n}. -* - GROW = ONE / MAX( XBND, SMLNUM ) - XBND = GROW - DO 60 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 80 -* -* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) -* - XJ = ONE + CNORM( J ) - GROW = MIN( GROW, XBND / XJ ) -* -* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) -* - TJJ = ABS( A( J, J ) ) - IF( XJ.GT.TJJ ) - $ XBND = XBND*( TJJ / XJ ) - 60 CONTINUE - GROW = MIN( GROW, XBND ) - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) ) - DO 70 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 80 -* -* G(j) = ( 1 + CNORM(j) )*G(j-1) -* - XJ = ONE + CNORM( J ) - GROW = GROW / XJ - 70 CONTINUE - END IF - 80 CONTINUE - END IF -* - IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN -* -* Use the Level 2 BLAS solve if the reciprocal of the bound on -* elements of X is not too small. -* - CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 ) - ELSE -* -* Use a Level 1 BLAS solve, scaling intermediate results. -* - IF( XMAX.GT.BIGNUM ) THEN -* -* Scale X so that its components are less than or equal to -* BIGNUM in absolute value. -* - SCALE = BIGNUM / XMAX - CALL DSCAL( N, SCALE, X, 1 ) - XMAX = BIGNUM - END IF -* - IF( NOTRAN ) THEN -* -* Solve A * x = b -* - DO 110 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) / A(j,j), scaling x if necessary. -* - XJ = ABS( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 100 - END IF - TJJ = ABS( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by 1/b(j). -* - REC = ONE / XJ - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = X( J ) / TJJS - XJ = ABS( X( J ) ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM -* to avoid overflow when dividing by A(j,j). -* - REC = ( TJJ*BIGNUM ) / XJ - IF( CNORM( J ).GT.ONE ) THEN -* -* Scale by 1/CNORM(j) to avoid overflow when -* multiplying x(j) times column j. -* - REC = REC / CNORM( J ) - END IF - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = X( J ) / TJJS - XJ = ABS( X( J ) ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A*x = 0. -* - DO 90 I = 1, N - X( I ) = ZERO - 90 CONTINUE - X( J ) = ONE - XJ = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 100 CONTINUE -* -* Scale x if necessary to avoid overflow when adding a -* multiple of column j of A. -* - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -* -* Scale x by 1/(2*abs(x(j))). -* - REC = REC*HALF - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - END IF - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -* -* Scale x by 1/2. -* - CALL DSCAL( N, HALF, X, 1 ) - SCALE = SCALE*HALF - END IF -* - IF( UPPER ) THEN - IF( J.GT.1 ) THEN -* -* Compute the update -* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) -* - CALL DAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X, - $ 1 ) - I = IDAMAX( J-1, X, 1 ) - XMAX = ABS( X( I ) ) - END IF - ELSE - IF( J.LT.N ) THEN -* -* Compute the update -* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) -* - CALL DAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1, - $ X( J+1 ), 1 ) - I = J + IDAMAX( N-J, X( J+1 ), 1 ) - XMAX = ABS( X( I ) ) - END IF - END IF - 110 CONTINUE -* - ELSE -* -* Solve A' * x = b -* - DO 160 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = ABS( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = ABS( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = USCAL / TJJS - END IF - IF( REC.LT.ONE ) THEN - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - SUMJ = ZERO - IF( USCAL.EQ.ONE ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call DDOT to perform the dot product. -* - IF( UPPER ) THEN - SUMJ = DDOT( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - SUMJ = DDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 120 I = 1, J - 1 - SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I ) - 120 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 130 I = J + 1, N - SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I ) - 130 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.TSCAL ) THEN -* -* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - SUMJ - XJ = ABS( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 150 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = ABS( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = X( J ) / TJJS - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL DSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = X( J ) / TJJS - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A'*x = 0. -* - DO 140 I = 1, N - X( I ) = ZERO - 140 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 150 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - sumj if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = X( J ) / TJJS - SUMJ - END IF - XMAX = MAX( XMAX, ABS( X( J ) ) ) - 160 CONTINUE - END IF - SCALE = SCALE / TSCAL - END IF -* -* Scale the column norms by 1/TSCAL for return. -* - IF( TSCAL.NE.ONE ) THEN - CALL DSCAL( N, ONE / TSCAL, CNORM, 1 ) - END IF -* - RETURN -* -* End of DLATRS -* - END diff --git a/testing/lin/dlauu2.f b/testing/lin/dlauu2.f deleted file mode 100644 index d49ac8dd90d8c8c213fe8df6c691130c937d261e..0000000000000000000000000000000000000000 --- a/testing/lin/dlauu2.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DLAUU2 computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the unblocked form of the algorithm, calling Level 2 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I - DOUBLE PRECISION AII -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DDOT - EXTERNAL LSAME, DDOT -* .. -* .. External Subroutines .. - EXTERNAL DGEMV, DSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLAUU2', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA ) - CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), - $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 ) - ELSE - CALL DSCAL( I, AII, A( 1, I ), 1 ) - END IF - 10 CONTINUE -* - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = DDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 ) - CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, - $ A( I+1, I ), 1, AII, A( I, 1 ), LDA ) - ELSE - CALL DSCAL( I, AII, A( I, 1 ), LDA ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of DLAUU2 -* - END diff --git a/testing/lin/dlauum.f b/testing/lin/dlauum.f deleted file mode 100644 index 76d31e2117bf5402cc5861245893752600d12c1a..0000000000000000000000000000000000000000 --- a/testing/lin/dlauum.f +++ /dev/null @@ -1,193 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DLAUUM computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the blocked form of the algorithm, calling Level 3 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IB, NB -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLAUU2, DSYRK, DTRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DLAUUM', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'DLAUUM', UPLO, N, -1, -1, -1 ) -* - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL DLAUU2( UPLO, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Non-unit', - $ I-1, IB, ONE, A( I, I ), LDA, A( 1, I ), - $ LDA ) - CALL DLAUU2( 'Upper', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL DGEMM( 'No transpose', 'Transpose', I-1, IB, - $ N-I-IB+1, ONE, A( 1, I+IB ), LDA, - $ A( I, I+IB ), LDA, ONE, A( 1, I ), LDA ) - CALL DSYRK( 'Upper', 'No transpose', IB, N-I-IB+1, - $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ), - $ LDA ) - END IF - 10 CONTINUE - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL DTRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB, - $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA ) - CALL DLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL DGEMM( 'Transpose', 'No transpose', IB, I-1, - $ N-I-IB+1, ONE, A( I+IB, I ), LDA, - $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA ) - CALL DSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE, - $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA ) - END IF - 20 CONTINUE - END IF - END IF -* - RETURN -* -* End of DLAUUM -* - END diff --git a/testing/lin/dlqt01.f b/testing/lin/dlqt01.f deleted file mode 100644 index 167f23fad2d32b5bebf10c8c9a5ac6096da9bb4c..0000000000000000000000000000000000000000 --- a/testing/lin/dlqt01.f +++ /dev/null @@ -1,194 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLQT01( M, N, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DLQT01 tests DGELQF, which computes the LQ factorization of an m-by-n -* matrix A, and partially tests DORGLQ which forms the n-by-n -* orthogonal matrix Q. -* -* DLQT01 compares L with A*Q', and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by DGELQF. -* See DGELQF for further details. -* -* Q (output) DOUBLE PRECISION array, dimension (LDA,N) -* The n-by-n orthogonal matrix Q. -* -* L (workspace) DOUBLE PRECISION array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. -* LDA >= max(M,N). -* -* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by DGELQF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (max(M,N)) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLANGE, DLANSY - EXTERNAL DLAMCH, DLANGE, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DGELQF, DGEMM, DLACPY, DLASET, DORGLQ, DSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, MIN -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'DGELQF' - CALL CHAMELEON_DGELQF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL DLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'DORGLQ' - CALL CHAMELEON_DORGLQ( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L -* - CALL DLASET( 'Full', M, M, ZERO, ZERO, L, LDA ) - CALL DLACPY( 'Lower', M, N, AF, LDA, L, LDA ) -* -* Compute L - A*Q' -* - CALL DGEMM( 'No transpose', 'Transpose', M, M, N, -ONE, A, LDA, Q, - $ LDA, ONE, L, LDA ) -* -* Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) . -* - ANORM = DLANGE( '1', M, N, A, LDA, RWORK ) - RESID = DLANGE( '1', M, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL DLASET( 'Full', M, M, ZERO, ONE, L, LDA ) - CALL DSYRK( 'Upper', 'No transpose', M, N, ONE, Q, LDA, -ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = DLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of DLQT01 -* - END diff --git a/testing/lin/dlqt02.f b/testing/lin/dlqt02.f deleted file mode 100644 index fb2ebc8ec41f5276e6381841dcf7d34c8e87ca5c..0000000000000000000000000000000000000000 --- a/testing/lin/dlqt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLQT02( M, N, K, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DLQT02 tests DORGLQ, which generates an m-by-n matrix Q with -* orthonornmal rows that is defined as the product of k elementary -* reflectors. -* -* Given the LQ factorization of an m-by-n matrix A, DLQT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and -* checks that the rows of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* N >= M >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. M >= K >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by DLQT01. -* -* AF (input) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by DGELQF. -* See DGELQF for further details. -* -* Q (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* L (workspace) DOUBLE PRECISION array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. LDA >= N. -* -* TAU (input) DOUBLE PRECISION array, dimension (M) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLANGE, DLANSY - EXTERNAL DLAMCH, DLANGE, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASET, DORGLQ, DSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - CALL DLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'DORGLQ' - CALL CHAMELEON_DORGLQ( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L(1:k,1:m) -* - CALL DLASET( 'Full', K, M, ZERO, ZERO, L, LDA ) - CALL DLACPY( 'Lower', K, M, AF, LDA, L, LDA ) -* -* Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' -* - CALL DGEMM( 'No transpose', 'Transpose', K, M, N, -ONE, A, LDA, Q, - $ LDA, ONE, L, LDA ) -* -* Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . -* - ANORM = DLANGE( '1', K, N, A, LDA, RWORK ) - RESID = DLANGE( '1', K, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL DLASET( 'Full', M, M, ZERO, ONE, L, LDA ) - CALL DSYRK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = DLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of DLQT02 -* - END diff --git a/testing/lin/dlqt03.f b/testing/lin/dlqt03.f deleted file mode 100644 index cc8f498fa52f8646c5378e5c0dd77dba65ca8e96..0000000000000000000000000000000000000000 --- a/testing/lin/dlqt03.f +++ /dev/null @@ -1,236 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DLQT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DLQT03 tests DORMLQ, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* DLQT03 compares the results of a call to DORMLQ with the results of -* forming Q explicitly by a call to DORGLQ and then performing matrix -* multiplication by a call to DGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows or columns of the matrix C; C is n-by-m if -* Q is applied from the left, or m-by-n if Q is applied from -* the right. M >= 0. -* -* N (input) INTEGER -* The order of the orthogonal matrix Q. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. N >= K >= 0. -* -* AF (input) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the LQ factorization of an m-by-n matrix, as -* returned by DGELQF. See SGELQF for further details. -* -* C (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* CC (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* Q (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) DOUBLE PRECISION array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an n-by-n orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( N * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( N * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( N * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( N * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D0 ) - PARAMETER ( ZERO = 0.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - DOUBLE PRECISION CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLARNV, DLASET, DORGLQ, DORMLQ -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL DLASET( 'Full', N, N, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDA ) - ENDIF -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'DORGLQ' - CALL CHAMELEON_DORGLQ( N, N, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = N - NC = M - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = M - NC = N - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL DLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = DLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.0.0D0 ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - END IF -* -* Copy C -* - CALL DLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'DORMLQ' - CALL CHAMELEON_DORMLQ( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL DGEMM( TRANS, 'No transpose', MC, NC, MC, -ONE, Q, - $ LDA, C, LDA, ONE, CC, LDA ) - ELSE - CALL DGEMM( 'No transpose', TRANS, MC, NC, NC, -ONE, C, - $ LDA, Q, LDA, ONE, CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = DLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( DBLE( MAX( 1, N ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of DLQT03 -* - END diff --git a/testing/lin/dpocon.f b/testing/lin/dpocon.f deleted file mode 100644 index 1a4c1b67aff75cead617c38adba9792e0bd3a4c2..0000000000000000000000000000000000000000 --- a/testing/lin/dpocon.f +++ /dev/null @@ -1,214 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N - DOUBLE PRECISION ANORM, RCOND -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - DOUBLE PRECISION A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* DPOCON estimates the reciprocal of the condition number (in the -* 1-norm) of a real symmetric positive definite matrix using the -* Cholesky factorization A = U^T*U or A = L*L^T computed by DPOTRF. -* -* An estimate is obtained for norm(inv(A)), and the reciprocal of the -* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^T*U or A = L*L^T, as computed by DPOTRF. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* ANORM (input) DOUBLE PRECISION -* The 1-norm (or infinity-norm) of the symmetric matrix A. -* -* RCOND (output) DOUBLE PRECISION -* The reciprocal of the condition number of the matrix A, -* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an -* estimate of the 1-norm of inv(A) computed in this routine. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - CHARACTER NORMIN - INTEGER IX, KASE - DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, IDAMAX, DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL DLACN2, DLATRS, DRSCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - ELSE IF( ANORM.LT.ZERO ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DPOCON', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - RCOND = ZERO - IF( N.EQ.0 ) THEN - RCOND = ONE - RETURN - ELSE IF( ANORM.EQ.ZERO ) THEN - RETURN - END IF -* - SMLNUM = DLAMCH( 'Safe minimum' ) -* -* Estimate the 1-norm of inv(A). -* - KASE = 0 - NORMIN = 'N' - 10 CONTINUE - CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( UPPER ) THEN -* -* Multiply by inv(U'). -* - CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, - $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) - NORMIN = 'Y' -* -* Multiply by inv(U). -* - CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) - ELSE -* -* Multiply by inv(L). -* - CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) - NORMIN = 'Y' -* -* Multiply by inv(L'). -* - CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A, - $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) - END IF -* -* Multiply by 1/SCALE if doing so will not cause overflow. -* - SCALE = SCALEL*SCALEU - IF( SCALE.NE.ONE ) THEN - IX = IDAMAX( N, WORK, 1 ) - IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) - $ GO TO 20 - CALL DRSCL( N, SCALE, WORK, 1 ) - END IF - GO TO 10 - END IF -* -* Compute the estimate of the reciprocal condition number. -* - IF( AINVNM.NE.ZERO ) - $ RCOND = ( ONE / AINVNM ) / ANORM -* - 20 CONTINUE - RETURN -* -* End of DPOCON -* - END diff --git a/testing/lin/dpoequ.f b/testing/lin/dpoequ.f deleted file mode 100644 index 7b20ec95a639c188fac46ac113527e09a465f2cc..0000000000000000000000000000000000000000 --- a/testing/lin/dpoequ.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOEQU( N, A, LDA, S, SCOND, AMAX, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, N - DOUBLE PRECISION AMAX, SCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), S( * ) -* .. -* -* Purpose -* ======= -* -* DPOEQU computes row and column scalings intended to equilibrate a -* symmetric positive definite matrix A and reduce its condition number -* (with respect to the two-norm). S contains the scale factors, -* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with -* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This -* choice of S puts the condition number of B within a factor N of the -* smallest possible condition number over all possible diagonal -* scalings. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The N-by-N symmetric positive definite matrix whose scaling -* factors are to be computed. Only the diagonal elements of A -* are referenced. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* S (output) DOUBLE PRECISION array, dimension (N) -* If INFO = 0, S contains the scale factors for A. -* -* SCOND (output) DOUBLE PRECISION -* If INFO = 0, S contains the ratio of the smallest S(i) to -* the largest S(i). If SCOND >= 0.1 and AMAX is neither too -* large nor too small, it is not worth scaling by S. -* -* AMAX (output) DOUBLE PRECISION -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the i-th diagonal element is nonpositive. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I - DOUBLE PRECISION SMIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, SQRT -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -3 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DPOEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) THEN - SCOND = ONE - AMAX = ZERO - RETURN - END IF -* -* Find the minimum and maximum diagonal elements. -* - S( 1 ) = A( 1, 1 ) - SMIN = S( 1 ) - AMAX = S( 1 ) - DO 10 I = 2, N - S( I ) = A( I, I ) - SMIN = MIN( SMIN, S( I ) ) - AMAX = MAX( AMAX, S( I ) ) - 10 CONTINUE -* - IF( SMIN.LE.ZERO ) THEN -* -* Find the first non-positive diagonal element and return. -* - DO 20 I = 1, N - IF( S( I ).LE.ZERO ) THEN - INFO = I - RETURN - END IF - 20 CONTINUE - ELSE -* -* Set the scale factors to the reciprocals -* of the diagonal elements. -* - DO 30 I = 1, N - S( I ) = ONE / SQRT( S( I ) ) - 30 CONTINUE -* -* Compute SCOND = min(S(I)) / max(S(I)) -* - SCOND = SQRT( SMIN ) / SQRT( AMAX ) - END IF - RETURN -* -* End of DPOEQU -* - END diff --git a/testing/lin/dporfs.f b/testing/lin/dporfs.f deleted file mode 100644 index c93d5793ae10f3ff52dca15a531106f49668b68a..0000000000000000000000000000000000000000 --- a/testing/lin/dporfs.f +++ /dev/null @@ -1,379 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, - $ LDX, FERR, BERR, WORK, IWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DPORFS improves the computed solution to a system of linear -* equations when the coefficient matrix is symmetric positive definite, -* and provides error bounds and backward error estimates for the -* solution. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The symmetric 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input) DOUBLE PRECISION array, dimension (LDAF,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^T*U or A = L*L^T, as computed by DPOTRF. -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* B (input) DOUBLE PRECISION array, dimension (LDB,NRHS) -* The right hand side matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS) -* On entry, the solution matrix X, as computed by DPOTRS. -* On exit, the improved solution matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* FERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* Internal Parameters -* =================== -* -* ITMAX is the maximum number of steps of iterative refinement. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D+0 ) - DOUBLE PRECISION THREE - PARAMETER ( THREE = 3.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER COUNT, I, J, K, KASE, NZ, CHAMELEON_UPLO - DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DPOTRS, DSYMV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -7 - ELSE IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -9 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DPORFS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN - DO 10 J = 1, NRHS - FERR( J ) = ZERO - BERR( J ) = ZERO - 10 CONTINUE - RETURN - END IF -* - IF ( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* -* NZ = maximum number of nonzero elements in each row of A, plus 1 -* - NZ = N + 1 - EPS = DLAMCH( 'Epsilon' ) - SAFMIN = DLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN - SAFE2 = SAFE1 / EPS -* -* Do for each right hand side -* - DO 140 J = 1, NRHS -* - COUNT = 1 - LSTRES = THREE - 20 CONTINUE -* -* Loop until stopping criterion is satisfied. -* -* Compute residual R = B - A * X -* - CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL DSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, - $ WORK( N+1 ), 1 ) -* -* Compute componentwise relative backward error from formula -* -* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) ) -* -* where abs(Z) is the componentwise absolute value of the matrix -* or vector Z. If the i-th component of the denominator is less -* than SAFE2, then SAFE1 is added to the i-th components of the -* numerator and denominator before dividing. -* - DO 30 I = 1, N - WORK( I ) = ABS( B( I, J ) ) - 30 CONTINUE -* -* Compute abs(A)*abs(X) + abs(B). -* - IF( UPPER ) THEN - DO 50 K = 1, N - S = ZERO - XK = ABS( X( K, J ) ) - DO 40 I = 1, K - 1 - WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK - S = S + ABS( A( I, K ) )*ABS( X( I, J ) ) - 40 CONTINUE - WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S - 50 CONTINUE - ELSE - DO 70 K = 1, N - S = ZERO - XK = ABS( X( K, J ) ) - WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK - DO 60 I = K + 1, N - WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK - S = S + ABS( A( I, K ) )*ABS( X( I, J ) ) - 60 CONTINUE - WORK( K ) = WORK( K ) + S - 70 CONTINUE - END IF - S = ZERO - DO 80 I = 1, N - IF( WORK( I ).GT.SAFE2 ) THEN - S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) ) - ELSE - S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) / - $ ( WORK( I )+SAFE1 ) ) - END IF - 80 CONTINUE - BERR( J ) = S -* -* Test stopping criterion. Continue iterating if -* 1) The residual BERR(J) is larger than machine epsilon, and -* 2) BERR(J) decreased by at least a factor of 2 during the -* last iteration, and -* 3) At most ITMAX iterations tried. -* - IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND. - $ COUNT.LE.ITMAX ) THEN -* -* Update solution and try again. -* - CALL CHAMELEON_DPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 ) - LSTRES = BERR( J ) - COUNT = COUNT + 1 - GO TO 20 - END IF -* -* Bound error from formula -* -* norm(X - XTRUE) / norm(X) .le. FERR = -* norm( abs(inv(A))* -* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X) -* -* where -* norm(Z) is the magnitude of the largest component of Z -* inv(A) is the inverse of A -* abs(Z) is the componentwise absolute value of the matrix or -* vector Z -* NZ is the maximum number of nonzeros in any row of A, plus 1 -* EPS is machine epsilon -* -* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B)) -* is incremented by SAFE1 if the i-th component of -* abs(A)*abs(X) + abs(B) is less than SAFE2. -* -* Use DLACN2 to estimate the infinity-norm of the matrix -* inv(A) * diag(W), -* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) -* - DO 90 I = 1, N - IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) - ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 - END IF - 90 CONTINUE -* - KASE = 0 - 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), - $ KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( KASE.EQ.1 ) THEN -* -* Multiply by diag(W)*inv(A'). -* - CALL CHAMELEON_DPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - 4 WORK( N+1 ), N, INFO ) - DO 110 I = 1, N - WORK( N+I ) = WORK( I )*WORK( N+I ) - 110 CONTINUE - ELSE IF( KASE.EQ.2 ) THEN -* -* Multiply by inv(A)*diag(W). -* - DO 120 I = 1, N - WORK( N+I ) = WORK( I )*WORK( N+I ) - 120 CONTINUE - CALL CHAMELEON_DPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - END IF - GO TO 100 - END IF -* -* Normalize error. -* - LSTRES = ZERO - DO 130 I = 1, N - LSTRES = MAX( LSTRES, ABS( X( I, J ) ) ) - 130 CONTINUE - IF( LSTRES.NE.ZERO ) - $ FERR( J ) = FERR( J ) / LSTRES -* - 140 CONTINUE -* - RETURN -* -* End of DPORFS -* - END diff --git a/testing/lin/dposvx.f b/testing/lin/dposvx.f deleted file mode 100644 index 79d723a27095f4205d0fcf03457417ac4f9eaa63..0000000000000000000000000000000000000000 --- a/testing/lin/dposvx.f +++ /dev/null @@ -1,423 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, - $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, - $ IWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK driver routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - INTEGER CHAMELEON_UPLO - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), FERR( * ), S( * ), WORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DPOSVX uses the Cholesky factorization A = U^T*U or A = L*L^T to -* compute the solution to a real system of linear equations -* A * X = B, -* where A is an N-by-N symmetric positive definite matrix and X and B -* are N-by-NRHS matrices. -* -* Error bounds on the solution and a condition estimate are also -* provided. -* -* Description -* =========== -* -* The following steps are performed: -* -* 1. If FACT = 'E', real scaling factors are computed to equilibrate -* the system: -* diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B -* Whether or not the system will be equilibrated depends on the -* scaling of the matrix A, but if equilibration is used, A is -* overwritten by diag(S)*A*diag(S) and B by diag(S)*B. -* -* 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to -* factor the matrix A (after equilibration if FACT = 'E') as -* A = U^T* U, if UPLO = 'U', or -* A = L * L^T, if UPLO = 'L', -* where U is an upper triangular matrix and L is a lower triangular -* matrix. -* -* 3. If the leading i-by-i principal minor is not positive definite, -* then the routine returns with INFO = i. Otherwise, the factored -* form of A is used to estimate the condition number of the matrix -* A. If the reciprocal of the condition number is less than machine -* precision, INFO = N+1 is returned as a warning, but the routine -* still goes on to solve for X and compute error bounds as -* described below. -* -* 4. The system of equations is solved for X using the factored form -* of A. -* -* 5. Iterative refinement is applied to improve the computed solution -* matrix and calculate error bounds and backward error estimates -* for it. -* -* 6. If equilibration was used, the matrix X is premultiplied by -* diag(S) so that it solves the original system before -* equilibration. -* -* Arguments -* ========= -* -* FACT (input) CHARACTER*1 -* Specifies whether or not the factored form of the matrix A is -* supplied on entry, and if not, whether the matrix A should be -* equilibrated before it is factored. -* = 'F': On entry, AF contains the factored form of A. -* If EQUED = 'Y', the matrix A has been equilibrated -* with scaling factors given by S. A and AF will not -* be modified. -* = 'N': The matrix A will be copied to AF and factored. -* = 'E': The matrix A will be equilibrated if necessary, then -* copied to AF and factored. -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The number of linear equations, i.e., the order of the -* matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the symmetric matrix A, except if FACT = 'F' and -* EQUED = 'Y', then A must contain the equilibrated matrix -* diag(S)*A*diag(S). 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. A is not modified if -* FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit. -* -* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by -* diag(S)*A*diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input or output) DOUBLE PRECISION array, dimension (LDAF,N) -* If FACT = 'F', then AF is an input argument and on entry -* contains the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T, in the same storage -* format as A. If EQUED .ne. 'N', then AF is the factored form -* of the equilibrated matrix diag(S)*A*diag(S). -* -* If FACT = 'N', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T of the original -* matrix A. -* -* If FACT = 'E', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T of the equilibrated -* matrix A (see the description of A for the form of the -* equilibrated matrix). -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* EQUED (input or output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration (always true if FACT = 'N'). -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* EQUED is an input argument if FACT = 'F'; otherwise, it is an -* output argument. -* -* S (input or output) DOUBLE PRECISION array, dimension (N) -* The scale factors for A; not accessed if EQUED = 'N'. S is -* an input argument if FACT = 'F'; otherwise, S is an output -* argument. If FACT = 'F' and EQUED = 'Y', each element of S -* must be positive. -* -* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) -* On entry, the N-by-NRHS right hand side matrix B. -* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y', -* B is overwritten by diag(S) * B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (output) DOUBLE PRECISION array, dimension (LDX,NRHS) -* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to -* the original system of equations. Note that if EQUED = 'Y', -* A and B are modified on exit, and the solution to the -* equilibrated system is inv(diag(S))*X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* RCOND (output) DOUBLE PRECISION -* The estimate of the reciprocal condition number of the matrix -* A after equilibration (if done). If RCOND is less than the -* machine precision (in particular, if RCOND = 0), the matrix -* is singular to working precision. This condition is -* indicated by a return code of INFO > 0. -* -* FERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= N: the leading minor of order i of A is -* not positive definite, so the factorization -* could not be completed, and the solution has not -* been computed. RCOND = 0 is returned. -* = N+1: U is nonsingular, but RCOND is less than machine -* precision, meaning that the matrix is singular -* to working precision. Nevertheless, the -* solution and error bounds are computed because -* there are a number of situations where the -* computed solution can be more accurate than the -* value of RCOND would suggest. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, RCEQU - INTEGER I, INFEQU, J - DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANSY - EXTERNAL LSAME, DLAMCH, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DLACPY, DLAQSY, DPOCON, DPOEQU, DPORFS, DPOTRF, - $ DPOTRS, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - RCEQU = .FALSE. - ELSE - RCEQU = LSAME( EQUED, 'Y' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) - $ THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -9 - ELSE - IF( RCEQU ) THEN - SMIN = BIGNUM - SMAX = ZERO - DO 10 J = 1, N - SMIN = MIN( SMIN, S( J ) ) - SMAX = MAX( SMAX, S( J ) ) - 10 CONTINUE - IF( SMIN.LE.ZERO ) THEN - INFO = -10 - ELSE IF( N.GT.0 ) THEN - SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM ) - ELSE - SCOND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -12 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -14 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DPOSVX', -INFO ) - RETURN - END IF -* - IF( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL DPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) - RCEQU = LSAME( EQUED, 'Y' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( RCEQU ) THEN - DO 30 J = 1, NRHS - DO 20 I = 1, N - B( I, J ) = S( I )*B( I, J ) - 20 CONTINUE - 30 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the Cholesky factorization A = U'*U or A = L*L'. -* - CALL DLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CHAMELEON_DPOTRF( CHAMELEON_UPLO, N, AF, LDAF, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 )THEN - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A. -* - ANORM = DLANSY( '1', UPLO, N, A, LDA, WORK ) -* -* Compute the reciprocal of the condition number of A. -* - CALL DPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CHAMELEON_DPOTRS( CHAMELEON_UPLO, N, NRHS, AF, LDAF, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, - $ FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( RCEQU ) THEN - DO 50 J = 1, NRHS - DO 40 I = 1, N - X( I, J ) = S( I )*X( I, J ) - 40 CONTINUE - 50 CONTINUE - DO 60 J = 1, NRHS - FERR( J ) = FERR( J ) / SCOND - 60 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RETURN -* -* End of DPOSVX -* - END diff --git a/testing/lin/dpot01.f b/testing/lin/dpot01.f deleted file mode 100644 index 6c69851a804b2d8098e9084160346abfe44c75af..0000000000000000000000000000000000000000 --- a/testing/lin/dpot01.f +++ /dev/null @@ -1,197 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAFAC, N - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AFAC( LDAFAC, * ), RWORK( * ) -* .. -* -* Purpose -* ======= -* -* DPOT01 reconstructs a symmetric positive definite matrix A from -* its L*L' or U'*U factorization and computes the residual -* norm( L*L' - A ) / ( N * norm(A) * EPS ) or -* norm( U'*U - A ) / ( N * norm(A) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AFAC (input/output) DOUBLE PRECISION array, dimension (LDAFAC,N) -* On entry, the factor L or U from the L*L' or U'*U -* factorization of A. -* Overwritten with the reconstructed matrix, and then with the -* difference L*L' - A (or U'*U - A). -* -* LDAFAC (input) INTEGER -* The leading dimension of the array AFAC. LDAFAC >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RESID (output) DOUBLE PRECISION -* If UPLO = 'L', norm(L*L' - A) / ( N * norm(A) * EPS ) -* If UPLO = 'U', norm(U'*U - A) / ( N * norm(A) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J, K - DOUBLE PRECISION ANORM, EPS, T -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DDOT, DLAMCH, DLANSY - EXTERNAL LSAME, DDOT, DLAMCH, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DSCAL, DSYR, DTRMV -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute the product U'*U, overwriting U. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 10 K = N, 1, -1 -* -* Compute the (K,K) element of the result. -* - T = DDOT( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) - AFAC( K, K ) = T -* -* Compute the rest of column K. -* - CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', K-1, AFAC, - $ LDAFAC, AFAC( 1, K ), 1 ) -* - 10 CONTINUE -* -* Compute the product L*L', overwriting L. -* - ELSE - DO 20 K = N, 1, -1 -* -* Add a multiple of column K of the factor L to each of -* columns K+1 through N. -* - IF( K+1.LE.N ) - $ CALL DSYR( 'Lower', N-K, ONE, AFAC( K+1, K ), 1, - $ AFAC( K+1, K+1 ), LDAFAC ) -* -* Scale column K by the diagonal element. -* - T = AFAC( K, K ) - CALL DSCAL( N-K+1, T, AFAC( K, K ), 1 ) -* - 20 CONTINUE - END IF -* -* Compute the difference L*L' - A (or U'*U - A). -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 40 J = 1, N - DO 30 I = 1, J - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 30 CONTINUE - 40 CONTINUE - ELSE - DO 60 J = 1, N - DO 50 I = J, N - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) -* - RESID = DLANSY( '1', UPLO, N, AFAC, LDAFAC, RWORK ) -* - RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS -* - RETURN -* -* End of DPOT01 -* - END diff --git a/testing/lin/dpot02.f b/testing/lin/dpot02.f deleted file mode 100644 index 909b4da62b5d9a177fc9fdedfbd3703412c59c98..0000000000000000000000000000000000000000 --- a/testing/lin/dpot02.f +++ /dev/null @@ -1,171 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, - $ RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DPOT02 computes the residual for the solution of a symmetric system -* of linear equations A*x = b: -* -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER J - DOUBLE PRECISION ANORM, BNORM, RHSNORM, EPS, XNORM -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, DLANSY, DLANGE - EXTERNAL DASUM, DLAMCH, DLANSY, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DSYMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) - RHSNORM = DLANGE( '1', N, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X -* - CALL DSYMM( 'Left', UPLO, N, NRHS, -ONE, A, LDA, X, LDX, ONE, B, - $ LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DASUM( N, B( 1, J ), 1 ) - XNORM = DASUM( N, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of DPOT02 -* - END diff --git a/testing/lin/dpot03.f b/testing/lin/dpot03.f deleted file mode 100644 index c0fa49cc74901ec5713d78763daa27893ba66418..0000000000000000000000000000000000000000 --- a/testing/lin/dpot03.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOT03( UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, - $ RWORK, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAINV, LDWORK, N - DOUBLE PRECISION RCOND, RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AINV( LDAINV, * ), RWORK( * ), - $ WORK( LDWORK, * ) -* .. -* -* Purpose -* ======= -* -* DPOT03 computes the residual for a symmetric matrix times its -* inverse: -* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AINV (input/output) DOUBLE PRECISION array, dimension (LDAINV,N) -* On entry, the inverse of the matrix A, stored as a symmetric -* matrix in the same format as A. -* In this version, AINV is expanded into a full matrix and -* multiplied by A, so the opposing triangle of AINV will be -* changed; i.e., if the upper triangular part of AINV is -* stored, the lower triangular part will be used as work space. -* -* LDAINV (input) INTEGER -* The leading dimension of the array AINV. LDAINV >= max(1,N). -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N) -* -* LDWORK (input) INTEGER -* The leading dimension of the array WORK. LDWORK >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RCOND (output) DOUBLE PRECISION -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(AINV). -* -* RESID (output) DOUBLE PRECISION -* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION AINVNM, ANORM, EPS -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE, DLANSY - EXTERNAL LSAME, DLAMCH, DLANGE, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DSYMM -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RCOND = ONE - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) - AINVNM = DLANSY( '1', UPLO, N, AINV, LDAINV, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCOND = ZERO - RESID = ONE / EPS - RETURN - END IF - RCOND = ( ONE / ANORM ) / AINVNM -* -* Expand AINV into a full matrix and call DSYMM to multiply -* AINV on the left by A. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - AINV( J, I ) = AINV( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE - DO 40 J = 1, N - DO 30 I = J + 1, N - AINV( J, I ) = AINV( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - CALL DSYMM( 'Left', UPLO, N, N, -ONE, A, LDA, AINV, LDAINV, ZERO, - $ WORK, LDWORK ) -* -* Add the identity matrix to WORK . -* - DO 50 I = 1, N - WORK( I, I ) = WORK( I, I ) + ONE - 50 CONTINUE -* -* Compute norm(I - A*AINV) / (N * norm(A) * norm(AINV) * EPS) -* - RESID = DLANGE( '1', N, N, WORK, LDWORK, RWORK ) -* - RESID = ( ( RESID*RCOND ) / EPS ) / DBLE( N ) -* - RETURN -* -* End of DPOT03 -* - END diff --git a/testing/lin/dpot05.f b/testing/lin/dpot05.f deleted file mode 100644 index c7a34a46d0e9897f2d83980f4bf4799db3ae7b80..0000000000000000000000000000000000000000 --- a/testing/lin/dpot05.f +++ /dev/null @@ -1,242 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOT05( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, - $ LDXACT, FERR, BERR, RESLTS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, LDXACT, N, NRHS -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ), - $ RESLTS( * ), X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* DPOT05 tests the error bounds from iterative refinement for the -* computed solution to a system of equations A*X = B, where A is a -* symmetric n by n matrix. -* -* RESLTS(1) = test of the error bound -* = norm(X - XACT) / ( norm(X) * FERR ) -* -* A large value is returned if this ratio is not less than one. -* -* RESLTS(2) = residual from the iterative refinement routine -* = the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows of the matrices X, B, and XACT, and the -* order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X, B, and XACT. -* NRHS >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The symmetric 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* B (input) DOUBLE PRECISION array, dimension (LDB,NRHS) -* The right hand side vectors for the system of linear -* equations. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* FERR (input) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bounds for each solution vector -* X. If XTRUE is the true solution, FERR bounds the magnitude -* of the largest entry in (X - XTRUE) divided by the magnitude -* of the largest entry in X. -* -* BERR (input) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector (i.e., the smallest relative change in any entry of A -* or B that makes X an exact solution). -* -* RESLTS (output) DOUBLE PRECISION array, dimension (2) -* The maximum over the NRHS solution vectors of the ratios: -* RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR ) -* RESLTS(2) = BERR / ( (n+1)*EPS + (*) ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IMAX, J, K - DOUBLE PRECISION AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, IDAMAX, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESLTS( 1 ) = ZERO - RESLTS( 2 ) = ZERO - RETURN - END IF -* - EPS = DLAMCH( 'Epsilon' ) - UNFL = DLAMCH( 'Safe minimum' ) - OVFL = ONE / UNFL - UPPER = LSAME( UPLO, 'U' ) -* -* Test 1: Compute the maximum of -* norm(X - XACT) / ( norm(X) * FERR ) -* over all the vectors X and XACT using the infinity-norm. -* - ERRBND = ZERO - DO 30 J = 1, NRHS - IMAX = IDAMAX( N, X( 1, J ), 1 ) - XNORM = MAX( ABS( X( IMAX, J ) ), UNFL ) - DIFF = ZERO - DO 10 I = 1, N - DIFF = MAX( DIFF, ABS( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE -* - IF( XNORM.GT.ONE ) THEN - GO TO 20 - ELSE IF( DIFF.LE.OVFL*XNORM ) THEN - GO TO 20 - ELSE - ERRBND = ONE / EPS - GO TO 30 - END IF -* - 20 CONTINUE - IF( DIFF / XNORM.LE.FERR( J ) ) THEN - ERRBND = MAX( ERRBND, ( DIFF / XNORM ) / FERR( J ) ) - ELSE - ERRBND = ONE / EPS - END IF - 30 CONTINUE - RESLTS( 1 ) = ERRBND -* -* Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* - DO 90 K = 1, NRHS - DO 80 I = 1, N - TMP = ABS( B( I, K ) ) - IF( UPPER ) THEN - DO 40 J = 1, I - TMP = TMP + ABS( A( J, I ) )*ABS( X( J, K ) ) - 40 CONTINUE - DO 50 J = I + 1, N - TMP = TMP + ABS( A( I, J ) )*ABS( X( J, K ) ) - 50 CONTINUE - ELSE - DO 60 J = 1, I - 1 - TMP = TMP + ABS( A( I, J ) )*ABS( X( J, K ) ) - 60 CONTINUE - DO 70 J = I, N - TMP = TMP + ABS( A( J, I ) )*ABS( X( J, K ) ) - 70 CONTINUE - END IF - IF( I.EQ.1 ) THEN - AXBI = TMP - ELSE - AXBI = MIN( AXBI, TMP ) - END IF - 80 CONTINUE - TMP = BERR( K ) / ( ( N+1 )*EPS+( N+1 )*UNFL / - $ MAX( AXBI, ( N+1 )*UNFL ) ) - IF( K.EQ.1 ) THEN - RESLTS( 2 ) = TMP - ELSE - RESLTS( 2 ) = MAX( RESLTS( 2 ), TMP ) - END IF - 90 CONTINUE -* - RETURN -* -* End of DPOT05 -* - END diff --git a/testing/lin/dpotri.f b/testing/lin/dpotri.f deleted file mode 100644 index 2a5f4c2dd8fcb52f69cc8a07855cad072e8e2cb4..0000000000000000000000000000000000000000 --- a/testing/lin/dpotri.f +++ /dev/null @@ -1,133 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DPOTRI computes the inverse of a real symmetric positive definite -* matrix A using the Cholesky factorization A = U^T*U or A = L*L^T -* computed by DPOTRF. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T, as computed by -* DPOTRF. -* On exit, the upper or lower triangle of the (symmetric) -* inverse of A, overwriting the input factor U or L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the (i,i) element of the factor U or L is -* zero, and the inverse could not be computed. -* -* ===================================================================== -* -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL DLAUUM, DTRTRI, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DPOTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Invert the triangular Cholesky factor U or L. -* - CALL DTRTRI( UPLO, 'Non-unit', N, A, LDA, INFO ) - IF( INFO.GT.0 ) - $ RETURN -* -* Form inv(U)*inv(U)' or inv(L)'*inv(L). -* - CALL DLAUUM( UPLO, N, A, LDA, INFO ) -* - RETURN -* -* End of DPOTRI -* - END diff --git a/testing/lin/dqrt01.f b/testing/lin/dqrt01.f deleted file mode 100644 index 2e8405229407f19dec895eac818a5c62163d0f04..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt01.f +++ /dev/null @@ -1,195 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT01( M, N, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DQRT01 tests DGEQRF, which computes the QR factorization of an m-by-n -* matrix A, and partially tests DORGQR which forms the m-by-m -* orthogonal matrix Q. -* -* DQRT01 compares R with Q'*A, and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by DGEQRF. -* See DGEQRF for further details. -* -* Q (output) DOUBLE PRECISION array, dimension (LDA,M) -* The m-by-m orthogonal matrix Q. -* -* R (workspace) DOUBLE PRECISION array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. -* LDA >= max(M,N). -* -* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by DGEQRF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLANGE, DLANSY - EXTERNAL DLAMCH, DLANGE, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DGEQRF, DLACPY, DLASET, DORGQR, DSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, MIN -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA ) -*, -* Factorize the matrix A in the array AF. -* - SRNAMT = 'DGEQRF' - CALL CHAMELEON_DGEQRF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL DLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'DORGQR' - CALL CHAMELEON_DORGQR( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R -* - CALL DLASET( 'Full', N, N, ZERO, ZERO, R, LDA ) - CALL DLACPY( 'Upper', M, N, AF, LDA, R, LDA ) -* -* Compute R - Q'*A -* - CALL DGEMM( 'Transpose', 'No transpose', N, N, M, -ONE, Q, LDA, - $ A, LDA, ONE, R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = DLANGE( '1', M, N, A, LDA, RWORK ) - RESID = DLANGE( '1', N, N, R, LDA, RWORK ) -* - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL DLASET( 'Full', N, N, ZERO, ONE, R, LDA ) - CALL DSYRK( 'Upper', 'Transpose', N, M, ONE, Q, LDA, -ONE, R, - $ LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = DLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of DQRT01 -* - END diff --git a/testing/lin/dqrt02.f b/testing/lin/dqrt02.f deleted file mode 100644 index 33129678b2b6498ee803937664b3bb3ca5ef9e9d..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT02( M, N, K, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DQRT02 tests DORGQR, which generates an m-by-n matrix Q with -* orthonornmal columns that is defined as the product of k elementary -* reflectors. -* -* Given the QR factorization of an m-by-n matrix A, DQRT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* columns of A; it compares R(1:n,1:k) with Q(1:m,1:n)'*A(1:m,1:k), -* and checks that the columns of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* M >= N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. N >= K >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by DQRT01. -* -* AF (input) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by DGEQRF. -* See DGEQRF for further details. -* -* Q (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* R (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. LDA >= M. -* -* TAU (input) DOUBLE PRECISION array, dimension (N) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLANGE, DLANSY - EXTERNAL DLAMCH, DLANGE, DLANSY -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASET, DORGQR, DSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k columns of the factorization to the array Q -* - CALL DLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'DORGQR' - CALL CHAMELEON_DORGQR( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R(1:n,1:k) -* - CALL DLASET( 'Full', N, K, ZERO, ZERO, R, LDA ) - CALL DLACPY( 'Upper', N, K, AF, LDA, R, LDA ) -* -* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) -* - CALL DGEMM( 'Transpose', 'No transpose', N, K, M, -ONE, Q, LDA, A, - $ LDA, ONE, R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = DLANGE( '1', M, K, A, LDA, RWORK ) - RESID = DLANGE( '1', N, K, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL DLASET( 'Full', N, N, ZERO, ONE, R, LDA ) - CALL DSYRK( 'Upper', 'Transpose', N, M, -ONE, Q, LDA, ONE, R, - $ LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = DLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of DQRT02 -* - END diff --git a/testing/lin/dqrt03.f b/testing/lin/dqrt03.f deleted file mode 100644 index 669d3722330657030352da39e4a8bb258afe6619..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt03.f +++ /dev/null @@ -1,237 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DQRT03 tests DORMQR, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* DQRT03 compares the results of a call to DORMQR with the results of -* forming Q explicitly by a call to DORGQR and then performing matrix -* multiplication by a call to DGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The order of the orthogonal matrix Q. M >= 0. -* -* N (input) INTEGER -* The number of rows or columns of the matrix C; C is m-by-n if -* Q is applied from the left, or n-by-m if Q is applied from -* the right. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. M >= K >= 0. -* -* AF (input) DOUBLE PRECISION array, dimension (LDA,N) -* Details of the QR factorization of an m-by-n matrix, as -* returnedby DGEQRF. See SGEQRF for further details. -* -* C (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* CC (workspace) DOUBLE PRECISION array, dimension (LDA,N) -* -* Q (workspace) DOUBLE PRECISION array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) DOUBLE PRECISION array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an m-by-m orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( M * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( M * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( M * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( M * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0 ) - PARAMETER ( ZERO = 0.0D+0 ) - DOUBLE PRECISION ROGUE - PARAMETER ( ROGUE = -1.0D+10 ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - DOUBLE PRECISION CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLARNV, DLASET, DORGQR, DORMQR -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) - WORK(1) = ONE -* -* Copy the first k columns of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL DLASET( 'Full', M, M, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL DLASET( 'Full', M, M, ZERO, ONE, Q, LDA ) - ENDIF -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'DORGQR' - CALL CHAMELEON_DORGQR( M, M, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = M - NC = N - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = N - NC = M - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL DLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = DLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.0.0D0 ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - END IF -* -* Copy C -* - CALL DLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'DORMQR' - CALL CHAMELEON_DORMQR( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL DLASET( 'Full', M, M, ZERO, ONE, Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL DGEMM( TRANS, 'No transpose', MC, NC, MC, -ONE, Q, - $ LDA, C, LDA, ONE, CC, LDA ) - ELSE - CALL DGEMM( 'No transpose', TRANS, MC, NC, NC, -ONE, C, - $ LDA, Q, LDA, ONE, CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = DLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( DBLE( MAX( 1, M ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of DQRT03 -* - END diff --git a/testing/lin/dqrt13.f b/testing/lin/dqrt13.f deleted file mode 100644 index f66e66f378073fef22b38102dc06886f749d4284..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt13.f +++ /dev/null @@ -1,153 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, M, N, SCALE - DOUBLE PRECISION NORMA -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DQRT13 generates a full-rank matrix that may be scaled to have large -* or small norm. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (output) DOUBLE PRECISION array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* NORMA (output) DOUBLE PRECISION -* The one-norm of A. -* -* ISEED (input/output) integer array, dimension (4) -* Seed for random number generator -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J - DOUBLE PRECISION BIGNUM, SMLNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, DLANGE - EXTERNAL DASUM, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, DLASCL -* .. -* .. Intrinsic Functions .. - INTRINSIC SIGN -* .. -* .. Local Arrays .. - DOUBLE PRECISION DUMMY( 1 ) -* .. -* .. Executable Statements .. -* - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN -* -* benign matrix -* - DO 10 J = 1, N - CALL DLARNV( 2, ISEED, M, A( 1, J ) ) - IF( J.LE.M ) THEN - A( J, J ) = A( J, J ) + SIGN( DASUM( M, A( 1, J ), 1 ), - $ A( J, J ) ) - END IF - 10 CONTINUE -* -* scaled versions -* - IF( SCALE.NE.1 ) THEN - NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / DLAMCH( 'Epsilon' ) - BIGNUM = ONE / SMLNUM -* - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA, - $ INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA, - $ INFO ) - END IF - END IF -* - NORMA = DLANGE( 'One-norm', M, N, A, LDA, DUMMY ) - RETURN -* -* End of DQRT13 -* - END diff --git a/testing/lin/dqrt14.f b/testing/lin/dqrt14.f deleted file mode 100644 index 6e2fa7014cf44f4e6465c3e6a18a3637aacb08ab..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt14.f +++ /dev/null @@ -1,228 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DQRT14( TRANS, M, N, NRHS, A, LDA, X, - $ LDX, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DQRT14 checks whether X is in the row space of A or A'. It does so -* by scaling both X and A such that their norms are in the range -* [sqrt(eps), 1/sqrt(eps)], then computing a QR factorization of [A,X] -* (if TRANS = 'T') or an LQ factorization of [A',X]' (if TRANS = 'N'), -* and returning the norm of the trailing triangle, scaled by -* MAX(M,N,NRHS)*eps. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* = 'N': No transpose, check for X in the row space of A -* = 'T': Transpose, check for X in the row space of A'. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of X. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* If TRANS = 'N', the N-by-NRHS matrix X. -* IF TRANS = 'T', the M-by-NRHS matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* -* WORK (workspace) DOUBLE PRECISION array dimension (LWORK) -* -* LWORK (input) INTEGER -* length of workspace array required -* If TRANS = 'N', LWORK >= (M+NRHS)*(N+2); -* if TRANS = 'T', LWORK >= (N+NRHS)*(M+2). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - LOGICAL TPSD - INTEGER I, INFO, J, LDWORK - DOUBLE PRECISION ANRM, ERR, XNRM -* .. -* .. Local Arrays .. - DOUBLE PRECISION RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGELQ2, DGEQR2, DLACPY, DLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, MIN -* .. -* .. Executable Statements .. -* - DQRT14 = ZERO - IF( LSAME( TRANS, 'N' ) ) THEN - LDWORK = M + NRHS - TPSD = .FALSE. - IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN - CALL XERBLA( 'DQRT14', 10 ) - RETURN - ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE IF( LSAME( TRANS, 'T' ) ) THEN - LDWORK = M - TPSD = .TRUE. - IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN - CALL XERBLA( 'DQRT14', 10 ) - RETURN - ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE - CALL XERBLA( 'DQRT14', 1 ) - RETURN - END IF -* -* Copy and scale A -* - CALL DLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) - ANRM = DLANGE( 'M', M, N, WORK, LDWORK, RWORK ) - IF( ANRM.NE.ZERO ) - $ CALL DLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) -* -* Copy X or X' into the right place and scale it -* - IF( TPSD ) THEN -* -* Copy X into columns n+1:n+nrhs of work -* - CALL DLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), - $ LDWORK ) - XNRM = DLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, - $ RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL DLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, - $ WORK( N*LDWORK+1 ), LDWORK, INFO ) - ANRM = DLANGE( 'One-norm', M, N+NRHS, WORK, LDWORK, RWORK ) -* -* Compute QR factorization of X -* - CALL DGEQR2( M, N+NRHS, WORK, LDWORK, - $ WORK( LDWORK*( N+NRHS )+1 ), - $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), - $ INFO ) -* -* Compute largest entry in upper triangle of -* work(n+1:m,n+1:n+nrhs) -* - ERR = ZERO - DO 20 J = N + 1, N + NRHS - DO 10 I = N + 1, MIN( M, J ) - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) - 10 CONTINUE - 20 CONTINUE -* - ELSE -* -* Copy X' into rows m+1:m+nrhs of work -* - DO 40 I = 1, N - DO 30 J = 1, NRHS - WORK( M+J+( I-1 )*LDWORK ) = X( I, J ) - 30 CONTINUE - 40 CONTINUE -* - XNRM = DLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL DLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), - $ LDWORK, INFO ) -* -* Compute LQ factorization of work -* - CALL DGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), - $ WORK( LDWORK*( N+1 )+1 ), INFO ) -* -* Compute largest entry in lower triangle in -* work(m+1:m+nrhs,m+1:n) -* - ERR = ZERO - DO 60 J = M + 1, N - DO 50 I = J, LDWORK - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) - 50 CONTINUE - 60 CONTINUE -* - END IF -* - DQRT14 = ERR / ( DBLE( MAX( M, N, NRHS ) )*DLAMCH( 'Epsilon' ) ) -* - RETURN -* -* End of DQRT14 -* - END diff --git a/testing/lin/dqrt15.f b/testing/lin/dqrt15.f deleted file mode 100644 index 2ab95099f5000f60449ea6bfdbaf977fd1110760..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt15.f +++ /dev/null @@ -1,264 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, - $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE - DOUBLE PRECISION NORMA, NORMB -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* DQRT15 generates a matrix with full or deficient rank and of various -* norms. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* RKSEL (input) INTEGER -* RKSEL = 1: full rank matrix -* RKSEL = 2: rank-deficient matrix -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* NRHS (input) INTEGER -* The number of columns of B. -* -* A (output) DOUBLE PRECISION array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* B (output) DOUBLE PRECISION array, dimension (LDB, NRHS) -* A matrix that is in the range space of matrix A. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* -* S (output) DOUBLE PRECISION array, dimension MIN(M,N) -* Singular values of A. -* -* RANK (output) INTEGER -* number of nonzero singular values of A. -* -* NORMA (output) DOUBLE PRECISION -* one-norm of A. -* -* NORMB (output) DOUBLE PRECISION -* one-norm of B. -* -* ISEED (input/output) integer array, dimension (4) -* seed for random number generator. -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* length of work space required. -* LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TWO, SVMIN - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, - $ SVMIN = 0.1D0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J, MN - DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP -* .. -* .. Local Arrays .. - DOUBLE PRECISION DUMMY( 1 ) -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, DLANGE, DLARND, DNRM2 - EXTERNAL DASUM, DLAMCH, DLANGE, DLARND, DNRM2 -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLAORD, DLARF, DLARNV, DLAROR, DLASCL, - $ DLASET, DSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - MN = MIN( M, N ) - IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN - CALL XERBLA( 'DQRT15', 16 ) - RETURN - END IF -* - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - EPS = DLAMCH( 'Epsilon' ) - SMLNUM = ( SMLNUM / EPS ) / EPS - BIGNUM = ONE / SMLNUM -* -* Determine rank and (unscaled) singular values -* - IF( RKSEL.EQ.1 ) THEN - RANK = MN - ELSE IF( RKSEL.EQ.2 ) THEN - RANK = ( 3*MN ) / 4 - DO 10 J = RANK + 1, MN - S( J ) = ZERO - 10 CONTINUE - ELSE - CALL XERBLA( 'DQRT15', 2 ) - END IF -* - IF( RANK.GT.0 ) THEN -* -* Nontrivial case -* - S( 1 ) = ONE - DO 30 J = 2, RANK - 20 CONTINUE - TEMP = DLARND( 1, ISEED ) - IF( TEMP.GT.SVMIN ) THEN - S( J ) = ABS( TEMP ) - ELSE - GO TO 20 - END IF - 30 CONTINUE - CALL DLAORD( 'Decreasing', RANK, S, 1 ) -* -* Generate 'rank' columns of a random orthogonal matrix in A -* - CALL DLARNV( 2, ISEED, M, WORK ) - CALL DSCAL( M, ONE / DNRM2( M, WORK, 1 ), WORK, 1 ) - CALL DLASET( 'Full', M, RANK, ZERO, ONE, A, LDA ) - CALL DLARF( 'Left', M, RANK, WORK, 1, TWO, A, LDA, - $ WORK( M+1 ) ) -* -* workspace used: m+mn -* -* Generate consistent rhs in the range space of A -* - CALL DLARNV( 2, ISEED, RANK*NRHS, WORK ) - CALL DGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, ONE, - $ A, LDA, WORK, RANK, ZERO, B, LDB ) -* -* work space used: <= mn *nrhs -* -* generate (unscaled) matrix A -* - DO 40 J = 1, RANK - CALL DSCAL( M, S( J ), A( 1, J ), 1 ) - 40 CONTINUE - IF( RANK.LT.N ) - $ CALL DLASET( 'Full', M, N-RANK, ZERO, ZERO, A( 1, RANK+1 ), - $ LDA ) - CALL DLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, - $ WORK, INFO ) -* - ELSE -* -* work space used 2*n+m -* -* Generate null matrix and rhs -* - DO 50 J = 1, MN - S( J ) = ZERO - 50 CONTINUE - CALL DLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) - CALL DLASET( 'Full', M, NRHS, ZERO, ZERO, B, LDB ) -* - END IF -* -* Scale the matrix -* - IF( SCALE.NE.1 ) THEN - NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY ) - IF( NORMA.NE.ZERO ) THEN - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, - $ LDA, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, - $ MN, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, - $ LDA, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, - $ MN, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE - CALL XERBLA( 'DQRT15', 1 ) - RETURN - END IF - END IF - END IF -* - NORMA = DASUM( MN, S, 1 ) - NORMB = DLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) -* - RETURN -* -* End of DQRT15 -* - END diff --git a/testing/lin/dqrt16.f b/testing/lin/dqrt16.f deleted file mode 100644 index 2d57c1746ccc66da3a6f8f0e113fd4ca05ff22dd..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt16.f +++ /dev/null @@ -1,180 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DQRT16( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DQRT16 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm(B - A*X) / ( max(m,n) * norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A'*x = b, where A' is the transpose of A -* = 'C': A'*x = b, where A' is the transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * norm(A) * norm(X) * EPS ). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - DOUBLE PRECISION ANORM, BNORM, EPS, RHSNORM, XNORM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DASUM, DLAMCH, DLANGE - EXTERNAL LSAME, DASUM, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - ANORM = DLANGE( 'I', M, N, A, LDA, RWORK ) - N1 = N - N2 = M - ELSE - ANORM = DLANGE( '1', M, N, A, LDA, RWORK ) - N1 = M - N2 = N - END IF - RHSNORM = DLANGE( 'I', N, NRHS, B, LDB, RWORK ) -* - EPS = DLAMCH( 'Epsilon' ) -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL DGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, - $ LDX, ONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DASUM( N1, B( 1, J ), 1 ) - XNORM = DASUM( N2, X( 1, J ), 1 ) - IF( ANORM.EQ.ZERO .AND. BNORM.EQ.ZERO ) THEN - RESID = ZERO - ELSE IF( ANORM.LE.ZERO .OR. XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM )/ (ANORM *XNORM + RHSNORM ) * - $ ( MAX( M, N )*EPS ) ) - END IF - 10 CONTINUE -* - RETURN -* -* End of DQRT16 -* - END diff --git a/testing/lin/dqrt17.f b/testing/lin/dqrt17.f deleted file mode 100644 index c4af1873b79752e57b571a408ed9c83a2ec1f3bc..0000000000000000000000000000000000000000 --- a/testing/lin/dqrt17.f +++ /dev/null @@ -1,217 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DQRT17( TRANS, IRESID, M, N, NRHS, A, - $ LDA, X, LDX, B, LDB, C, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER IRESID, LDA, LDB, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDB, * ), - $ WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* DQRT17 computes the ratio -* -* || R'*op(A) ||/(||A||*alpha*max(M,N,NRHS)*eps) -* -* where R = op(A)*X - B, op(A) is A or A', and -* -* alpha = ||B|| if IRESID = 1 (zero-residual problem) -* alpha = ||R|| if IRESID = 2 (otherwise). -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies whether or not the transpose of A is used. -* = 'N': No transpose, op(A) = A. -* = 'T': Transpose, op(A) = A'. -* -* IRESID (input) INTEGER -* IRESID = 1 indicates zero-residual problem. -* IRESID = 2 indicates non-zero residual. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* If TRANS = 'N', the number of rows of the matrix B. -* If TRANS = 'T', the number of rows of the matrix X. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* If TRANS = 'N', the number of rows of the matrix X. -* If TRANS = 'T', the number of rows of the matrix B. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and B. -* -* A (input) DOUBLE PRECISION array, dimension (LDA,N) -* The m-by-n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* X (input) DOUBLE PRECISION array, dimension (LDX,NRHS) -* If TRANS = 'N', the n-by-nrhs matrix X. -* If TRANS = 'T', the m-by-nrhs matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* If TRANS = 'N', LDX >= N. -* If TRANS = 'T', LDX >= M. -* -* B (input) DOUBLE PRECISION array, dimension (LDB,NRHS) -* If TRANS = 'N', the m-by-nrhs matrix B. -* If TRANS = 'T', the n-by-nrhs matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* If TRANS = 'N', LDB >= M. -* If TRANS = 'T', LDB >= N. -* -* C (workspace) DOUBLE PRECISION array, dimension (LDB,NRHS) -* -* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of the array WORK. LWORK >= NRHS*(M+N). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, ISCL, NCOLS, NROWS - DOUBLE PRECISION BIGNUM, ERR, NORMA, NORMB, NORMRS, NORMX, - $ SMLNUM -* .. -* .. Local Arrays .. - DOUBLE PRECISION RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, DLAMCH, DLANGE -* .. -* .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX -* .. -* .. Executable Statements .. -* - DQRT17 = ZERO -* - IF( LSAME( TRANS, 'N' ) ) THEN - NROWS = M - NCOLS = N - ELSE IF( LSAME( TRANS, 'T' ) ) THEN - NROWS = N - NCOLS = M - ELSE - CALL XERBLA( 'DQRT17', 1 ) - RETURN - END IF -* - IF( LWORK.LT.NCOLS*NRHS ) THEN - CALL XERBLA( 'DQRT17', 13 ) - RETURN - END IF -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF -* - NORMA = DLANGE( 'One-norm', M, N, A, LDA, RWORK ) - SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - ISCL = 0 -* -* compute residual and scale it -* - CALL DLACPY( 'All', NROWS, NRHS, B, LDB, C, LDB ) - CALL DGEMM( TRANS, 'No transpose', NROWS, NRHS, NCOLS, -ONE, A, - $ LDA, X, LDX, ONE, C, LDB ) - NORMRS = DLANGE( 'Max', NROWS, NRHS, C, LDB, RWORK ) - IF( NORMRS.GT.SMLNUM ) THEN - ISCL = 1 - CALL DLASCL( 'General', 0, 0, NORMRS, ONE, NROWS, NRHS, C, LDB, - $ INFO ) - END IF -* -* compute R'*A -* - CALL DGEMM( 'Transpose', TRANS, NRHS, NCOLS, NROWS, ONE, C, LDB, - $ A, LDA, ZERO, WORK, NRHS ) -* -* compute and properly scale error -* - ERR = DLANGE( 'One-norm', NRHS, NCOLS, WORK, NRHS, RWORK ) - IF( NORMA.NE.ZERO ) - $ ERR = ERR / NORMA -* - IF( ISCL.EQ.1 ) - $ ERR = ERR*NORMRS -* - IF( IRESID.EQ.1 ) THEN - NORMB = DLANGE( 'One-norm', NROWS, NRHS, B, LDB, RWORK ) - IF( NORMB.NE.ZERO ) - $ ERR = ERR / NORMB - ELSE - NORMX = DLANGE( 'One-norm', NCOLS, NRHS, X, LDX, RWORK ) - IF( NORMX.NE.ZERO ) - $ ERR = ERR / NORMX - END IF -* - DQRT17 = ERR / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N, NRHS ) ) ) - RETURN -* -* End of DQRT17 -* - END diff --git a/testing/lin/drscl.f b/testing/lin/drscl.f deleted file mode 100644 index beb3a88ad6f1d68dfdc21d475cd378a89fddffc4..0000000000000000000000000000000000000000 --- a/testing/lin/drscl.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DRSCL( N, SA, SX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N - DOUBLE PRECISION SA -* .. -* .. Array Arguments .. - DOUBLE PRECISION SX( * ) -* .. -* -* Purpose -* ======= -* -* DRSCL multiplies an n-element real vector x by the real scalar 1/a. -* This is done without overflow or underflow as long as -* the final result x/a does not overflow or underflow. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of components of the vector x. -* -* SA (input) DOUBLE PRECISION -* The scalar a which is used to divide each component of x. -* SA must be >= 0, or the subroutine will divide by zero. -* -* SX (input/output) DOUBLE PRECISION array, dimension -* (1+(N-1)*abs(INCX)) -* The n-element vector x. -* -* INCX (input) INTEGER -* The increment between successive values of the vector SX. -* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL DSCAL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) -* -* Initialize the denominator to SA and the numerator to 1. -* - CDEN = SA - CNUM = ONE -* - 10 CONTINUE - CDEN1 = CDEN*SMLNUM - CNUM1 = CNUM / BIGNUM - IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN -* -* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. -* - MUL = SMLNUM - DONE = .FALSE. - CDEN = CDEN1 - ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN -* -* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. -* - MUL = BIGNUM - DONE = .FALSE. - CNUM = CNUM1 - ELSE -* -* Multiply X by CNUM / CDEN and return. -* - MUL = CNUM / CDEN - DONE = .TRUE. - END IF -* -* Scale the vector X by MUL -* - CALL DSCAL( N, MUL, SX, INCX ) -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of DRSCL -* - END diff --git a/testing/lin/dtest.in b/testing/lin/dtest.in deleted file mode 100644 index 15bb9ea420bcbfbd056df9473a92172cc9f0d282..0000000000000000000000000000000000000000 --- a/testing/lin/dtest.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing DOUBLE PRECISION CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -0 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -DGE 11 List types on next line if 0 < NTYPES < 11 -DPO 9 List types on next line if 0 < NTYPES < 9 -DLS 6 List types on next line if 0 < NTYPES < 6 -DQR 8 List types on next line if 0 < NTYPES < 8 -DLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/dtestdyn.in b/testing/lin/dtestdyn.in deleted file mode 100644 index f772bfc58f4ff6c0e6b01eed39108c716e47b7f0..0000000000000000000000000000000000000000 --- a/testing/lin/dtestdyn.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing DOUBLE PRECISION CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -1 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -DGE 11 List types on next line if 0 < NTYPES < 11 -DPO 9 List types on next line if 0 < NTYPES < 9 -DLS 6 List types on next line if 0 < NTYPES < 6 -DQR 8 List types on next line if 0 < NTYPES < 8 -DLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/dtrti2.f b/testing/lin/dtrti2.f deleted file mode 100644 index 8c9902f525c3c72a85fb34817cdc3c721d0637fe..0000000000000000000000000000000000000000 --- a/testing/lin/dtrti2.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DTRTI2 computes the inverse of a real upper or lower triangular -* matrix. -* -* This is the Level 2 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading n by n upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading n by n lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J - DOUBLE PRECISION AJJ -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL DSCAL, DTRMV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DTRTI2', -INFO ) - RETURN - END IF -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix. -* - DO 10 J = 1, N - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF -* -* Compute elements 1:j-1 of j-th column. -* - CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA, - $ A( 1, J ), 1 ) - CALL DSCAL( J-1, AJJ, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix. -* - DO 20 J = N, 1, -1 - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF - IF( J.LT.N ) THEN -* -* Compute elements j+1:n of j-th column. -* - CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J, - $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) - CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of DTRTI2 -* - END diff --git a/testing/lin/dtrtri.f b/testing/lin/dtrtri.f deleted file mode 100644 index 780c8e6eb536bc2ae3958fb17c85ecfe1b911b2e..0000000000000000000000000000000000000000 --- a/testing/lin/dtrtri.f +++ /dev/null @@ -1,214 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* DTRTRI computes the inverse of a real upper or lower triangular -* matrix A. -* -* This is the Level 3 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': A is upper triangular; -* = 'L': A is lower triangular. -* -* DIAG (input) CHARACTER*1 -* = 'N': A is non-unit triangular; -* = 'U': A is unit triangular. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading N-by-N upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading N-by-N lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, A(i,i) is exactly zero. The triangular -* matrix is singular and its inverse can not be computed. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J, JB, NB, NN -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL DTRMM, DTRSM, DTRTI2, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DTRTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Check for singularity if non-unit. -* - IF( NOUNIT ) THEN - DO 10 INFO = 1, N - IF( A( INFO, INFO ).EQ.ZERO ) - $ RETURN - 10 CONTINUE - INFO = 0 - END IF -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 ) - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix -* - DO 20 J = 1, N, NB - JB = MIN( NB, N-J+1 ) -* -* Compute rows 1:j-1 of current block column -* - CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, - $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, - $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) -* -* Compute inverse of current diagonal block -* - CALL DTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) - 20 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix -* - NN = ( ( N-1 ) / NB )*NB + 1 - DO 30 J = NN, 1, -NB - JB = MIN( NB, N-J+1 ) - IF( J+JB.LE.N ) THEN -* -* Compute rows j+jb:n of current block column -* - CALL DTRMM( 'Left', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, - $ A( J+JB, J ), LDA ) - CALL DTRSM( 'Right', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, - $ A( J+JB, J ), LDA ) - END IF -* -* Compute inverse of current diagonal block -* - CALL DTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) - 30 CONTINUE - END IF - END IF -* - RETURN -* -* End of DTRTRI -* - END diff --git a/testing/lin/dzsum1.f b/testing/lin/dzsum1.f deleted file mode 100644 index 5aff9406d377fb86b054c9bcc1a188d71c925129..0000000000000000000000000000000000000000 --- a/testing/lin/dzsum1.f +++ /dev/null @@ -1,118 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N -* .. -* .. Array Arguments .. - COMPLEX*16 CX( * ) -* .. -* -* Purpose -* ======= -* -* DZSUM1 takes the sum of the absolute values of a complex -* vector and returns a double precision result. -* -* Based on DZASUM from the Level 1 BLAS. -* The change is to use the 'genuine' absolute value. -* -* Contributed by Nick Higham for use with ZLACON. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of elements in the vector CX. -* -* CX (input) COMPLEX*16 array, dimension (N) -* The vector whose elements will be summed. -* -* INCX (input) INTEGER -* The spacing between successive values of CX. INCX > 0. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, NINCX - DOUBLE PRECISION STEMP -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* - DZSUM1 = 0.0D0 - STEMP = 0.0D0 - IF( N.LE.0 ) - $ RETURN - IF( INCX.EQ.1 ) - $ GO TO 20 -* -* CODE FOR INCREMENT NOT EQUAL TO 1 -* - NINCX = N*INCX - DO 10 I = 1, NINCX, INCX -* -* NEXT LINE MODIFIED. -* - STEMP = STEMP + ABS( CX( I ) ) - 10 CONTINUE - DZSUM1 = STEMP - RETURN -* -* CODE FOR INCREMENT EQUAL TO 1 -* - 20 CONTINUE - DO 30 I = 1, N -* -* NEXT LINE MODIFIED. -* - STEMP = STEMP + ABS( CX( I ) ) - 30 CONTINUE - DZSUM1 = STEMP - RETURN -* -* End of DZSUM1 -* - END diff --git a/testing/lin/icmax1.f b/testing/lin/icmax1.f deleted file mode 100644 index 6b6800570d513d573f8205efeaa29ef8fd3ed0d6..0000000000000000000000000000000000000000 --- a/testing/lin/icmax1.f +++ /dev/null @@ -1,132 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - INTEGER FUNCTION ICMAX1( N, CX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N -* .. -* .. Array Arguments .. - COMPLEX CX( * ) -* .. -* -* Purpose -* ======= -* -* ICMAX1 finds the index of the element whose real part has maximum -* absolute value. -* -* Based on ICAMAX from Level 1 BLAS. -* The change is to use the 'genuine' absolute value. -* -* Contributed by Nick Higham for use with CLACON. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of elements in the vector CX. -* -* CX (input) COMPLEX array, dimension (N) -* The vector whose elements will be summed. -* -* INCX (input) INTEGER -* The spacing between successive values of CX. INCX >= 1. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, IX - REAL SMAX - COMPLEX ZDUM -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Statement Functions .. - REAL CABS1 -* .. -* .. Statement Function definitions .. -* -* NEXT LINE IS THE ONLY MODIFICATION. - CABS1( ZDUM ) = ABS( ZDUM ) -* .. -* .. Executable Statements .. -* - ICMAX1 = 0 - IF( N.LT.1 ) - $ RETURN - ICMAX1 = 1 - IF( N.EQ.1 ) - $ RETURN - IF( INCX.EQ.1 ) - $ GO TO 30 -* -* CODE FOR INCREMENT NOT EQUAL TO 1 -* - IX = 1 - SMAX = CABS1( CX( 1 ) ) - IX = IX + INCX - DO 20 I = 2, N - IF( CABS1( CX( IX ) ).LE.SMAX ) - $ GO TO 10 - ICMAX1 = I - SMAX = CABS1( CX( IX ) ) - 10 CONTINUE - IX = IX + INCX - 20 CONTINUE - RETURN -* -* CODE FOR INCREMENT EQUAL TO 1 -* - 30 CONTINUE - SMAX = CABS1( CX( 1 ) ) - DO 40 I = 2, N - IF( CABS1( CX( I ) ).LE.SMAX ) - $ GO TO 40 - ICMAX1 = I - SMAX = CABS1( CX( I ) ) - 40 CONTINUE - RETURN -* -* End of ICMAX1 -* - END diff --git a/testing/lin/izmax1.f b/testing/lin/izmax1.f deleted file mode 100644 index a5160c233001eb2548c1940b1ca24154d5793de1..0000000000000000000000000000000000000000 --- a/testing/lin/izmax1.f +++ /dev/null @@ -1,132 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - INTEGER FUNCTION IZMAX1( N, CX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N -* .. -* .. Array Arguments .. - COMPLEX*16 CX( * ) -* .. -* -* Purpose -* ======= -* -* IZMAX1 finds the index of the element whose real part has maximum -* absolute value. -* -* Based on IZAMAX from Level 1 BLAS. -* The change is to use the 'genuine' absolute value. -* -* Contributed by Nick Higham for use with ZLACON. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of elements in the vector CX. -* -* CX (input) COMPLEX*16 array, dimension (N) -* The vector whose elements will be summed. -* -* INCX (input) INTEGER -* The spacing between successive values of CX. INCX >= 1. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, IX - DOUBLE PRECISION SMAX - COMPLEX*16 ZDUM -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. -* -* NEXT LINE IS THE ONLY MODIFICATION. - CABS1( ZDUM ) = ABS( ZDUM ) -* .. -* .. Executable Statements .. -* - IZMAX1 = 0 - IF( N.LT.1 ) - $ RETURN - IZMAX1 = 1 - IF( N.EQ.1 ) - $ RETURN - IF( INCX.EQ.1 ) - $ GO TO 30 -* -* CODE FOR INCREMENT NOT EQUAL TO 1 -* - IX = 1 - SMAX = CABS1( CX( 1 ) ) - IX = IX + INCX - DO 20 I = 2, N - IF( CABS1( CX( IX ) ).LE.SMAX ) - $ GO TO 10 - IZMAX1 = I - SMAX = CABS1( CX( IX ) ) - 10 CONTINUE - IX = IX + INCX - 20 CONTINUE - RETURN -* -* CODE FOR INCREMENT EQUAL TO 1 -* - 30 CONTINUE - SMAX = CABS1( CX( 1 ) ) - DO 40 I = 2, N - IF( CABS1( CX( I ) ).LE.SMAX ) - $ GO TO 40 - IZMAX1 = I - SMAX = CABS1( CX( I ) ) - 40 CONTINUE - RETURN -* -* End of IZMAX1 -* - END diff --git a/testing/lin/lsamen.f b/testing/lin/lsamen.f deleted file mode 100644 index f922dfe1468fbdd105c62bc786176b86bcaef854..0000000000000000000000000000000000000000 --- a/testing/lin/lsamen.f +++ /dev/null @@ -1,104 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - LOGICAL FUNCTION LSAMEN( N, CA, CB ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*( * ) CA, CB - INTEGER N -* .. -* -* Purpose -* ======= -* -* LSAMEN tests if the first N letters of CA are the same as the -* first N letters of CB, regardless of case. -* LSAMEN returns .TRUE. if CA and CB are equivalent except for case -* and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA ) -* or LEN( CB ) is less than N. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of characters in CA and CB to be compared. -* -* CA (input) CHARACTER*(*) -* CB (input) CHARACTER*(*) -* CA and CB specify two character strings of length at least N. -* Only the first N characters of each string will be accessed. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC LEN -* .. -* .. Executable Statements .. -* - LSAMEN = .FALSE. - IF( LEN( CA ).LT.N .OR. LEN( CB ).LT.N ) - $ GO TO 20 -* -* Do for each character in the two strings. -* - DO 10 I = 1, N -* -* Test if the characters are equal using LSAME. -* - IF( .NOT.LSAME( CA( I: I ), CB( I: I ) ) ) - $ GO TO 20 -* - 10 CONTINUE - LSAMEN = .TRUE. -* - 20 CONTINUE - RETURN -* -* End of LSAMEN -* - END diff --git a/testing/lin/schkaa.f b/testing/lin/schkaa.f deleted file mode 100644 index 9987a53375c387194fdec3c6d5583113ff6593b6..0000000000000000000000000000000000000000 --- a/testing/lin/schkaa.f +++ /dev/null @@ -1,635 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - PROGRAM SCHKAA -* - INCLUDE 'chameleon_fortran.h' -* -* -- CHAMELEON test routine (From LAPACK version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* Purpose -* ======= -* -* SCHKAA is the main test program for the REAL CHAMELEON -* linear equation routines -* -* The program must be driven by a short data file. The first 14 records -* specify problem dimensions and program options using list-directed -* input. The remaining lines specify the CHAMELEON test paths and the -* number of matrix types to use in testing. An annotated example of a -* data file can be obtained by deleting the first 3 characters from the -* following 36 lines: -* Data file for testing REAL CHAMELEON linear eqn. routines -* 1 Number of values of NP -* 16 Values of NP (number of cores) -* 1 Values of SCHED (0: STATIC, 1:DYNAMIC) -* 7 Number of values of M -* 0 1 2 3 5 10 16 Values of M (row dimension) -* 7 Number of values of N -* 0 1 2 3 5 10 16 Values of N (column dimension) -* 1 Number of values of NRHS -* 2 Values of NRHS (number of right hand sides) -* 5 Number of values of NB -* 1 3 3 3 20 Values of NB (the blocksize) -* 1 0 5 9 1 Values of NX (crossover point) -* 3 Number of values of RANK -* 30 50 90 Values of rank (as a % of N) -* 20.0 Threshold value of test ratio -* T Put T to test the CHAMELEON routines -* T Put T to test the driver routines -* T Put T to test the error exits -* SGE 11 List types on next line if 0 < NTYPES < 11 -* SGB 8 List types on next line if 0 < NTYPES < 8 -* SGT 12 List types on next line if 0 < NTYPES < 12 -* SPO 9 List types on next line if 0 < NTYPES < 9 -* SPS 9 List types on next line if 0 < NTYPES < 9 -* SPP 9 List types on next line if 0 < NTYPES < 9 -* SPB 8 List types on next line if 0 < NTYPES < 8 -* SPT 12 List types on next line if 0 < NTYPES < 12 -* SSY 10 List types on next line if 0 < NTYPES < 10 -* SSP 10 List types on next line if 0 < NTYPES < 10 -* STR 18 List types on next line if 0 < NTYPES < 18 -* STP 18 List types on next line if 0 < NTYPES < 18 -* STB 17 List types on next line if 0 < NTYPES < 17 -* SQR 8 List types on next line if 0 < NTYPES < 8 -* SRQ 8 List types on next line if 0 < NTYPES < 8 -* SLQ 8 List types on next line if 0 < NTYPES < 8 -* SQL 8 List types on next line if 0 < NTYPES < 8 -* SQP 6 List types on next line if 0 < NTYPES < 6 -* STZ 3 List types on next line if 0 < NTYPES < 3 -* SLS 6 List types on next line if 0 < NTYPES < 6 -* SEQ -* -* Internal Parameters -* =================== -* -* NMAX INTEGER -* The maximum allowable value for N -* -* MAXIN INTEGER -* The number of different values that can be used for each of -* M, N, NRHS, NB, and NX -* -* MAXRHS INTEGER -* The maximum number of right hand sides -* -* NIN INTEGER -* The unit number for input -* -* NOUT INTEGER -* The unit number for output -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NPMAX - PARAMETER ( NPMAX = 16 ) - INTEGER NMAX - PARAMETER ( NMAX = 1000 ) - INTEGER MAXIN - PARAMETER ( MAXIN = 12 ) - INTEGER MAXRHS - PARAMETER ( MAXRHS = 16 ) - INTEGER MATMAX - PARAMETER ( MATMAX = 30 ) - INTEGER NIN, NOUT - PARAMETER ( NIN = 5, NOUT = 6 ) - INTEGER KDMAX - PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) -* .. -* .. Local Scalars .. - LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR - CHARACTER C1 - CHARACTER*2 C2 - CHARACTER*3 PATH - CHARACTER*10 INTSTR - CHARACTER*72 ALINE - INTEGER I, IB, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, - $ NN, NNB, NNB2, NNP, NNS, NP, SCHED, NRHS, NTYPES, - $ NRANK, VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO - REAL EPS, S1, S2, THREQ, THRESH -* .. -* .. Local Arrays .. - LOGICAL DOTYPE( MATMAX ) - INTEGER IBVAL(MAXIN), IWORK( 25*NMAX ), MVAL( MAXIN ), - $ NBVAL( MAXIN ), NBVAL2( MAXIN ), - $ NPVAL( MAXIN), NSVAL( MAXIN ), - $ NVAL( MAXIN ), NXVAL( MAXIN ), - $ RANKVAL( MAXIN ), PIV( NMAX ) - REAL A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), - $ RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ), - $ WORK( NMAX, NMAX+MAXRHS+30 ) -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - REAL SECOND, SLAMCH - EXTERNAL LSAME, LSAMEN, SECOND, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL ALAREQ, SCHKGE, SCHKLQ, - $ SCHKPO, - $ SCHKQR, - $ SDRVGE, - $ SDRVLS, SDRVPO, - $ ILAVER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Arrays in Common .. - INTEGER IPARMS( 100 ) -* .. -* .. Common blocks .. - COMMON / CLAENV / IPARMS - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA THREQ / 2.0E0 / , INTSTR / '0123456789' / -* .. -* .. Executable Statements .. -* -* S1 = SECOND( ) - LDA = NMAX - FATAL = .FALSE. -* -* Report values of parameters version. -* - CALL CHAMELEON_VERSION( VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO) - WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH -* -* Read a dummy line. -* - READ( NIN, FMT = * ) -* -* Read the values of NP -* - READ( NIN, FMT = * )NNP - IF( NNP.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNP ', NNP, 1 - NNP = 0 - FATAL = .TRUE. - ELSE IF( NNP.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNP ', NNP, MAXIN - NNP = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NPVAL( I ), I = 1, NNP ) - DO 01 I = 1, NNP - IF( NPVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NP ', NPVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NPVAL( I ).GT.NPMAX ) THEN - WRITE( NOUT, FMT = 9995 )' NP ', NPVAL( I ), NPMAX - FATAL = .TRUE. - END IF - 01 CONTINUE - IF( NNP.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NP ', ( NPVAL( I ), I = 1, NNP ) -* -* Read the values of SCHED -* - READ( NIN, FMT = * )SCHED - IF (( SCHED .LT. 0 ) .OR. (SCHED .GT. 1)) THEN - WRITE( NOUT, FMT = 9987 )' SCHED ', SCHED - SCHED = 0 - FATAL = .TRUE. - END IF -* -* Read the values of M -* - READ( NIN, FMT = * )NM - IF( NM.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 - NM = 0 - FATAL = .TRUE. - ELSE IF( NM.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN - NM = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) - DO 10 I = 1, NM - IF( MVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( MVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX - FATAL = .TRUE. - END IF - 10 CONTINUE - IF( NM.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) -* -* Read the values of N -* - READ( NIN, FMT = * )NN - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 - NN = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN - NN = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) - DO 20 I = 1, NN - IF( NVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX - FATAL = .TRUE. - END IF - 20 CONTINUE - IF( NN.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) -* -* Read the values of NRHS -* - READ( NIN, FMT = * )NNS - IF( NNS.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 - NNS = 0 - FATAL = .TRUE. - ELSE IF( NNS.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN - NNS = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) - DO 30 I = 1, NNS - IF( NSVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN - WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS - FATAL = .TRUE. - END IF - 30 CONTINUE - IF( NNS.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) -* -* Read the values of NB -* - READ( NIN, FMT = * )NNB - IF( NNB.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 - NNB = 0 - FATAL = .TRUE. - ELSE IF( NNB.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN - NNB = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) - DO 40 I = 1, NNB - IF( NBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 - FATAL = .TRUE. - END IF - 40 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) -* -* Read the values of IB -* - READ( NIN, FMT = * )( IBVAL( I ), I = 1, NNB ) - DO 41 I = 1, NNB - IF( IBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', IBVAL( I ), 0 - FATAL = .TRUE. - END IF - 41 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'IB ', ( IBVAL( I ), I = 1, NNB ) -* -* Set NBVAL2 to be the set of unique values of NB -* - NNB2 = 0 - DO 60 I = 1, NNB - NB = NBVAL( I ) - DO 50 J = 1, NNB2 - IF( NB.EQ.NBVAL2( J ) ) - $ GO TO 60 - 50 CONTINUE - NNB2 = NNB2 + 1 - NBVAL2( NNB2 ) = NB - 60 CONTINUE -* -* Read the values of NX -* - READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) - DO 70 I = 1, NNB - IF( NXVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 - FATAL = .TRUE. - END IF - 70 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) -* -* Read the values of RANKVAL -* - READ( NIN, FMT = * )NRANK - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 - NRANK = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN - NRANK = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) - DO I = 1, NRANK - IF( RANKVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( RANKVAL( I ).GT.100 ) THEN - WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 - FATAL = .TRUE. - END IF - END DO - IF( NRANK.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', - $ ( RANKVAL( I ), I = 1, NRANK ) -* -* Read the threshold value for the test ratios. -* - READ( NIN, FMT = * )THRESH - WRITE( NOUT, FMT = 9992 )THRESH -* -* Read the flag that indicates whether to test the CHAMELEON routines. -* - READ( NIN, FMT = * )TSTCHK -* -* Read the flag that indicates whether to test the driver routines. -* - READ( NIN, FMT = * )TSTDRV -* -* Read the flag that indicates whether to test the error exits. -* - READ( NIN, FMT = * )TSTERR -* - IF( FATAL ) THEN - WRITE( NOUT, FMT = 9999 ) - STOP - END IF -* -* Calculate and print the machine dependent constants. -* - EPS = SLAMCH( 'Underflow threshold' ) - WRITE( NOUT, FMT = 9991 )'underflow', EPS - EPS = SLAMCH( 'Overflow threshold' ) - WRITE( NOUT, FMT = 9991 )'overflow ', EPS - EPS = SLAMCH( 'Epsilon' ) - WRITE( NOUT, FMT = 9991 )'precision', EPS - WRITE( NOUT, FMT = * ) -* -* Initialize CHAMELEON -* - CALL CHAMELEON_INIT( NPVAL(NNP), INFO ) -* - IF( SCHED .EQ. 1 ) THEN - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_DYNAMIC_SCHEDULING, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_STATIC_SCHEDULING, INFO ) - ENDIF -* - CALL CHAMELEON_DISABLE( CHAMELEON_AUTOTUNING, INFO ) -* -* - 80 CONTINUE -* -* Read a test path and the number of matrix types to use. -* - READ( NIN, FMT = '(A72)', END = 140 )ALINE - PATH = ALINE( 1: 3 ) - NMATS = MATMAX - I = 3 - 90 CONTINUE - I = I + 1 - IF( I.GT.72 ) THEN - NMATS = MATMAX - GO TO 130 - END IF - IF( ALINE( I: I ).EQ.' ' ) - $ GO TO 90 - NMATS = 0 - 100 CONTINUE - C1 = ALINE( I: I ) - DO 110 K = 1, 10 - IF( C1.EQ.INTSTR( K: K ) ) THEN - IC = K - 1 - GO TO 120 - END IF - 110 CONTINUE - GO TO 130 - 120 CONTINUE - NMATS = NMATS*10 + IC - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - GO TO 100 - 130 CONTINUE - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - NRHS = NSVAL( 1 ) -* -* Check first character for correct precision. -* - IF( .NOT.LSAME( C1, 'Single precision' ) ) THEN - WRITE( NOUT, FMT = 9990 )PATH -* - ELSE IF( NMATS.LE.0 ) THEN -* -* Check for a positive number of tests requested. -* - WRITE( NOUT, FMT = 9989 )PATH -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* GE: general matrices -* - NTYPES = 11 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL SCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), - $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL SDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* PO: positive definite matrices -* - NTYPES = 9 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL SCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, - $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), - $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL SDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN -* -* QR: QR factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL SCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN -* -* LQ: LQ factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* LS: Least squares drivers -* - NTYPES = 6 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTDRV ) THEN - CALL SDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), - $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ RWORK, RWORK( NMAX+1 ), IBVAL, WORK, IWORK, - $ NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE -* - WRITE( NOUT, FMT = 9990 )PATH - END IF -* -* Go back to get another input line. -* - GO TO 80 -* -* Branch to this line when the last record is read. -* - 140 CONTINUE - CLOSE ( NIN ) -* -* Finalize CHAMELEON -* - CALL CHAMELEON_FINALIZE( INFO ) -* S2 = SECOND( ) - WRITE( NOUT, FMT = 9998 ) -* WRITE( NOUT, FMT = 9997 )S2 - S1 -* - 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / ' End of tests' ) - 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) - 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', - $ I6 ) - 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', - $ I6 ) - 9994 FORMAT( ' Tests of the REAL CHAMELEON routines ', - $ / ' CHAMELEON VERSION ', I1, '.', I1, '.', I1, - $ / / ' The following parameter values will be used:' ) - 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) - 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', - $ 'less than', F8.2, / ) - 9991 FORMAT( ' Relative machine ', A, ' is taken to be', E16.6 ) - 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) - 9989 FORMAT( / 1X, A3, ' routines were not tested' ) - 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) - 9987 FORMAT( ' Invalid input value: ', A6, '=', I6, '; must be 0 or 1') -* -* End of SCHKAA -* - END diff --git a/testing/lin/schkge.f b/testing/lin/schkge.f deleted file mode 100644 index 3e74b3fb9f505d5776e5e1ec0f5730ff4c3d62bd..0000000000000000000000000000000000000000 --- a/testing/lin/schkge.f +++ /dev/null @@ -1,448 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, - $ AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IBVAL( * ), IWORK( * ), MVAL( * ), NBVAL( * ), - $ NSVAL( * ), NVAL( * ) - REAL A( * ), AFAC( * ), AINV( * ), B( * ), - $ RWORK( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SCHKGE tests SGETRF, -TRI, -TRS, -RFS, and -CON. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AFAC (workspace) REAL array, dimension (NMAX*NMAX) -* -* AINV (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) REAL array, dimension (NMAX*NSMAX) -* -* XACT (workspace) REAL array, dimension (NMAX*NSMAX) -* -* WORK (workspace) REAL array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) REAL array, dimension -* (max(2*NMAX,2*NSMAX+NWORK)) -* -* IWORK (workspace) INTEGER array, dimension (2*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* ONLY NOTRANS SUPPORTED !!! - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL TRFCON, ZEROT - CHARACTER DIST, NORM, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IM, IMAT, IB, IN, INB, INFO, IOFF, IRHS, - $ ITRAN, IZERO, K, KL, KU, LDA, LWORK, M, MODE, - $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT - REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY, - $ RCOND, RCONDC, RCONDI, RCONDO - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER CHAMELEON_TRANS -* .. -* .. Local Arrays .. - CHARACTER TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL SGET06, SLANGE - EXTERNAL SGET06, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRGE, SGECON, SGERFS, - $ SGET02, SGET04, SGETRF, - $ SGETRI, SGETRS, SLACPY, SLARHS, SLASET, SLATB4, - $ SLATMS, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / , -* $ TRANSS / 'N', 'T', 'C' / - $ TRANSS / 'N' / - $ CHAMELEON_TRANSS / CHAMELEONNOTRANS / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - CALL XLAENV( 1, 1 ) - IF( TSTERR ) - $ CALL SERRGE( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of M in MVAL -* - DO 120 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* -* Do for each value of N in NVAL -* - DO 110 IN = 1, NN - N = NVAL( IN ) - XTYPE = 'N' - NIMAT = NTYPES - IF( M.LE.0 .OR. N.LE.0 ) - $ NIMAT = 1 -* - DO 100 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 100 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 100 -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'SLATMS' - CALL SLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = MIN( M, N ) - ELSE - IZERO = MIN( M, N ) / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, M - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL SLASET( 'Full', M, N-IZERO+1, ZERO, ZERO, - $ A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Do for each blocksize in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* ALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_SGETRF_INCPIV( -c$$$ $ M, N, HL, HPIV, INFO ) -* -* Compute the LU factorization of the matrix. -* - CALL SLACPY( 'Full', M, N, A, LDA, AFAC, LDA ) - SRNAMT = 'SGETRF' -c$$$ CALL CHAMELEON_SGETRF_INCPIV( M, N, AFAC, LDA, HL, HPIV, -c$$$ $ INFO ) - CALL CHAMELEON_SGETRF( M, N, AFAC, LDA, IWORK, - $ INFO ) -* -* Check error code from SGETRF. -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'SGETRF', INFO, IZERO, ' ', M, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - TRFCON = .FALSE. - NT = 0 -* - IF( M.NE.N .OR. INFO.NE.0 ) THEN -* -* Do only the condition estimate if INFO > 0. -* - TRFCON = .TRUE. - ANORMO = SLANGE( 'O', M, N, A, LDA, RWORK ) - ANORMI = SLANGE( 'I', M, N, A, LDA, RWORK ) - RCONDO = ZERO - RCONDI = ZERO - END IF -* -* Print information about the tests so far that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT -* -* Skip the remaining tests if this is not the first -* block size or if M .ne. N. Skip the solve tests if -* the matrix is singular. -* -* IF( INB.GT.1 .OR. M.NE.N ) -* $ GO TO 90 - IF( TRFCON ) - $ GO TO 70 -* - DO 60 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) - XTYPE = 'N' -* - DO 50 ITRAN = 1, NTRAN - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -*+ TEST 3 -* Solve and compute residual for A * X = B. -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, - $ LDA, ISEED, INFO ) - XTYPE = 'C' -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) - SRNAMT = 'SGETRS' -c$$$ CALL CHAMELEON_SGETRS_INCPIV( CHAMELEON_TRANS, N, -c$$$ $ NRHS, AFAC, LDA, HL, HPIV, -c$$$ $ X, LDA, INFO ) - CALL CHAMELEON_SGETRS( CHAMELEON_TRANS, N, - $ NRHS, AFAC, LDA, IWORK, - $ X, LDA, INFO ) -* -* Check error code from SGETRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SGETRS', INFO, 0, TRANS, - $ N, N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL SGET02( TRANS, N, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -* Print information about the tests that did not -* pass the threshold. -* - DO 40 K = 3, 4 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 40 CONTINUE - NRUN = NRUN + 2 - 50 CONTINUE - 60 CONTINUE -* - 70 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M = ', I5, ', N =', I5, ', NB =', I4, ', type ', I2, - $ ', test(', I2, ') =', G12.5 ) - 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of SCHKGE -* - END diff --git a/testing/lin/schklq.f b/testing/lin/schklq.f deleted file mode 100644 index 39ffca9430a77458a86a8afc139cddb21883bad5..0000000000000000000000000000000000000000 --- a/testing/lin/schklq.f +++ /dev/null @@ -1,405 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AL, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), - $ B( * ), RWORK( * ), TAU( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SCHKLQ tests SGELQF, SORGLQ and SORMLQ. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AF (workspace) REAL array, dimension (NMAX*NMAX) -* -* AQ (workspace) REAL array, dimension (NMAX*NMAX) -* -* AL (workspace) REAL array, dimension (NMAX*NMAX) -* -* AC (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NRHS) -* -* X (workspace) REAL array, dimension (NMAX*NRHS) -* -* XACT (workspace) REAL array, dimension (NMAX*NRHS) -* -* TAU (workspace) REAL array, dimension (NMAX) -* -* WORK (workspace) REAL array, dimension (NMAX*NMAX) -* -* RWORK (workspace) REAL array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - REAL ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - REAL RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL SGENND - EXTERNAL SGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGET02, - $ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02, - $ SLQT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'LQ' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL SERRLQ( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( N.LT.M ) - $ GO TO 60 - MINMN = MIN( M, N ) - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'SLATMS' - CALL SLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of SLQT01; other values are -* used in the calls of SLQT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGELQF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test SGELQF -* - CALL SLQT01( M, N, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.SGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.LE.N ) THEN -* -* Test SORGLQ, using factorization -* returned by SLQT01 -* - CALL SLQT02( M, N, K, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - END IF - IF( M.GE.K ) THEN -* -* Test SORMLQ, using factorization returned -* by SLQT01 -* - CALL SLQT03( M, N, K, AF, AC, AL, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call SGELQS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.M .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL SLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'SGELQS' - CALL CHAMELEON_SGELQS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from SGELQS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SGELQS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL SGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - END IF - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NTESTS - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', - $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of SCHKLQ -* - END diff --git a/testing/lin/schkpo.f b/testing/lin/schkpo.f deleted file mode 100644 index 48a3f808a572a5d4d638185fa3f76a6a7886e571..0000000000000000000000000000000000000000 --- a/testing/lin/schkpo.f +++ /dev/null @@ -1,476 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, - $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, - $ XACT, WORK, RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) - REAL A( * ), AFAC( * ), AINV( * ), B( * ), - $ RWORK( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SCHKPO tests SPOTRF, -TRI, -TRS, -RFS, and -CON -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AFAC (workspace) REAL array, dimension (NMAX*NMAX) -* -* AINV (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) REAL array, dimension (NMAX*NSMAX) -* -* XACT (workspace) REAL array, dimension (NMAX*NSMAX) -* -* WORK (workspace) REAL array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) REAL array, dimension -* (max(NMAX,2*NSMAX)) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* .. -* .. Local Scalars .. - LOGICAL ZEROT - CHARACTER DIST, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO, - $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS, - $ NFAIL, NIMAT, NRHS, NRUN - INTEGER CHAMELEON_UPLO - REAL ANORM, CNDNUM, RCOND, RCONDC -* .. -* .. Local Arrays .. - CHARACTER UPLOS( 2 ) - INTEGER CHAMELEON_UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL SGET06, SLANSY - EXTERNAL SGET06, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRPO, SGET04, SLACPY, - $ SLARHS, SLATB4, SLATMS, SPOCON, SPORFS, SPOT01, - $ SPOT02, SPOT03, SPOT05, SPOTRF, SPOTRI, SPOTRS, - $ XLAENV -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL SERRPO( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of N in NVAL -* - DO 120 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - IZERO = 0 - DO 110 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 110 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 110 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 100 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'SLATMS' - CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Do for each value of NB in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (N / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Compute the L*L' or U'*U factorization of the matrix. -* - CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - SRNAMT = 'SPOTRF' - CALL CHAMELEON_SPOTRF( CHAMELEON_UPLO, N, AFAC, LDA, INFO ) -* -* Check error code from SPOTRF. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'SPOTRF', INFO, IZERO, UPLO, N, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - GO TO 90 - END IF -* -* Skip the tests if INFO is not 0. -* - IF( INFO.NE.0 ) - $ GO TO 90 -* -*+ TEST 1 -* Reconstruct matrix from factors and compute residual. -* - CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - CALL SPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK, - $ RESULT( 1 ) ) -* -*+ TEST 2 -* Form the inverse and compute the residual. -* - CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - SRNAMT = 'SPOTRI' - CALL CHAMELEON_SPOTRI( CHAMELEON_UPLO, N, AINV, LDA, - $ INFO ) -* -* Check error code from SPOTRI. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SPOTRI', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - CALL SPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, - $ RWORK, RCONDC, RESULT( 2 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 60 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + 2 -* -* Skip the rest of the tests unless this is the first -* blocksize. -* - IF( INB.NE.1 ) - $ GO TO 90 -* - DO 80 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) -* -*+ TEST 3 -* Solve and compute residual for A * X = B . -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'SPOTRS' - CALL CHAMELEON_SPOTRS( CHAMELEON_UPLO, N, NRHS, AFAC, - $ LDA, X, LDA, INFO ) -* -* Check error code from SPOTRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SPOTRS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) - CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -*+ TESTS 5, 6, and 7 -* Use iterative refinement to improve the solution. -* - SRNAMT = 'SPORFS' - CALL SPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B, - $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ), - $ WORK, IWORK, INFO ) -* -* Check error code from SPORFS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SPORFS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 5 ) ) - CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, - $ XACT, LDA, RWORK, RWORK( NRHS+1 ), - $ RESULT( 6 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 70 K = 3, 7 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 70 CONTINUE - NRUN = NRUN + 5 - 80 CONTINUE -* -*+ TEST 8 -* Get an estimate of RCOND = 1/CNDNUM. -* - ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) - SRNAMT = 'SPOCON' - CALL SPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK, - $ IWORK, INFO ) -* -* Check error code from SPOCON. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SPOCON', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - RESULT( 8 ) = SGET06( RCOND, RCONDC ) -* -* Print the test ratio if it is .GE. THRESH. -* - IF( RESULT( 8 ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8, - $ RESULT( 8 ) - NFAIL = NFAIL + 1 - END IF - NRUN = NRUN + 1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', - $ I2, ', test ', I2, ', ratio =', G12.5 ) - 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of SCHKPO -* - END diff --git a/testing/lin/schkqr.f b/testing/lin/schkqr.f deleted file mode 100644 index 67e5f281fb61a610d68eaf7cd9a7019937afccb4..0000000000000000000000000000000000000000 --- a/testing/lin/schkqr.f +++ /dev/null @@ -1,410 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IBVAL( * ), IWORK( * ), MVAL( * ), NBVAL( * ), - $ NVAL( * ), NXVAL( * ) - REAL A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), - $ B( * ), RWORK( * ), TAU( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SCHKQR tests SGEQRF, SORGQR and SORMQR. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AF (workspace) REAL array, dimension (NMAX*NMAX) -* -* AQ (workspace) REAL array, dimension (NMAX*NMAX) -* -* AR (workspace) REAL array, dimension (NMAX*NMAX) -* -* AC (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NRHS) -* -* X (workspace) REAL array, dimension (NMAX*NRHS) -* -* XACT (workspace) REAL array, dimension (NMAX*NRHS) -* -* TAU (workspace) REAL array, dimension (NMAX) -* -* WORK (workspace) REAL array, dimension (NMAX*NMAX) -* -* RWORK (workspace) REAL array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IB, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, - $ LDA, LWORK, M, MINMN, MODE, N, NB, NERRS, - $ NFAIL, NK, NRUN, NT, NX, IRH, RHBLK - REAL ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - REAL RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL SGENND - EXTERNAL SGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGET02, - $ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01, SQRT02, - $ SQRT03, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'QR' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL SERRQR( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( M.LT.N ) - $ GO TO 60 - MINMN = MIN( M, N ) -* - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'SLATMS' - CALL SLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of SQRT01; other values are -* used in the calls of SQRT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGEQRF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test SGEQRF -* - CALL SQRT01( M, N, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.SGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.GE.N ) THEN -* -* Test SORGQR, using factorization -* returned by SQRT01 -* - CALL SQRT02( M, N, K, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - END IF - IF( M.GE.K ) THEN -* -* Test SORMQR, using factorization returned -* by SQRT01 -* - CALL SQRT03( M, N, K, AF, AC, AR, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call SGEQRS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.N .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL SLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'SGEQRS' - CALL CHAMELEON_SGEQRS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from SGEQRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SGEQRS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL SGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - END IF - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NT - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, IB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', IB=', - $ I4, ', NX=', I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of SCHKQR -* - END diff --git a/testing/lin/scsum1.f b/testing/lin/scsum1.f deleted file mode 100644 index 4770d3ed8f6e9ceb0bcef0ea17e9aa6bda5e6d00..0000000000000000000000000000000000000000 --- a/testing/lin/scsum1.f +++ /dev/null @@ -1,118 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SCSUM1( N, CX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N -* .. -* .. Array Arguments .. - COMPLEX CX( * ) -* .. -* -* Purpose -* ======= -* -* SCSUM1 takes the sum of the absolute values of a complex -* vector and returns a single precision result. -* -* Based on SCASUM from the Level 1 BLAS. -* The change is to use the 'genuine' absolute value. -* -* Contributed by Nick Higham for use with CLACON. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of elements in the vector CX. -* -* CX (input) COMPLEX array, dimension (N) -* The vector whose elements will be summed. -* -* INCX (input) INTEGER -* The spacing between successive values of CX. INCX > 0. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, NINCX - REAL STEMP -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* - SCSUM1 = 0.0E0 - STEMP = 0.0E0 - IF( N.LE.0 ) - $ RETURN - IF( INCX.EQ.1 ) - $ GO TO 20 -* -* CODE FOR INCREMENT NOT EQUAL TO 1 -* - NINCX = N*INCX - DO 10 I = 1, NINCX, INCX -* -* NEXT LINE MODIFIED. -* - STEMP = STEMP + ABS( CX( I ) ) - 10 CONTINUE - SCSUM1 = STEMP - RETURN -* -* CODE FOR INCREMENT EQUAL TO 1 -* - 20 CONTINUE - DO 30 I = 1, N -* -* NEXT LINE MODIFIED. -* - STEMP = STEMP + ABS( CX( I ) ) - 30 CONTINUE - SCSUM1 = STEMP - RETURN -* -* End of SCSUM1 -* - END diff --git a/testing/lin/sdrvge.f b/testing/lin/sdrvge.f deleted file mode 100644 index 6f15937f28ab6bbf207277ca3429cd542f1e0517..0000000000000000000000000000000000000000 --- a/testing/lin/sdrvge.f +++ /dev/null @@ -1,471 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - REAL A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SDRVGE tests the driver routines SGESV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AFAC (workspace) REAL array, dimension (NMAX*NMAX) -* -* ASAV (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NRHS) -* -* BSAV (workspace) REAL array, dimension (NMAX*NRHS) -* -* X (workspace) REAL array, dimension (NMAX*NRHS) -* -* XACT (workspace) REAL array, dimension (NMAX*NRHS) -* -* S (workspace) REAL array, dimension (2*NMAX) -* -* WORK (workspace) REAL array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) REAL array, dimension (2*NRHS+NMAX) -* -* IWORK (workspace) INTEGER array, dimension (2*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT - CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, - $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, - $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, IB - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER CHAMELEON_TRANS - REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, - $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, - $ ROLDI, ROLDO, ROWCND, RPVGRW -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SGET06, SLAMCH, SLANGE, SLANTR - EXTERNAL LSAME, SGET06, SLAMCH, SLANGE, SLANTR -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV, - $ SGESVX, SGET02, SGET04, SGETRF, - $ SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4, - $ SLATMS, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* DATA TRANSS / 'N', 'T', 'C' / - DATA TRANSS / 'N' / - DATA CHAMELEON_TRANSS / CHAMELEONNOTRANS / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'R', 'C', 'B' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL SERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - IB = 32 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* Do for each value of N in NVAL -* - DO 90 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* -* ALLOCATE L and IPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_DGETRF_INCPIV( -c$$$ $ N, N, HL, HPIV, INFO ) -* -* - DO 80 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 80 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 80 -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) - RCONDC = ONE / CNDNUM -* - SRNAMT = 'SLATMS' - CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, - $ ANORM, KL, KU, 'No packing', A, LDA, WORK, - $ INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, -1, -1, - $ -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 80 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, N - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO, - $ A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL SLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) -* - DO 70 IEQUED = 1, 4 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 60 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 60 - RCONDO = ZERO - RCONDI = ZERO -* - ELSE IF( .NOT.NOFACT ) THEN -* -* Compute the condition number for comparison with -* the value returned by SGESVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL SLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL SGEEQU( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( LSAME( EQUED, 'R' ) ) THEN - ROWCND = ZERO - COLCND = ONE - ELSE IF( LSAME( EQUED, 'C' ) ) THEN - ROWCND = ONE - COLCND = ZERO - ELSE IF( LSAME( EQUED, 'B' ) ) THEN - ROWCND = ZERO - COLCND = ZERO - END IF -* -* Equilibrate the matrix. -* - CALL SLAQGE( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the non-equilibrated -* system for use in SGET04. -* - IF( EQUIL ) THEN - ROLDO = RCONDO - ROLDI = RCONDI - END IF -* -* Compute the 1-norm and infinity-norm of A. -* - ANORMO = SLANGE( '1', N, N, AFAC, LDA, RWORK ) - ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* -c$$$ CALL CHAMELEON_SGETRF_INCPIV( N, N, AFAC, LDA, -c$$$ $ HL, HPIV, INFO ) - CALL CHAMELEON_SGETRF( N, N, AFAC, LDA, - $ IWORK, INFO ) - END IF -* - DO 50 ITRAN = 1, NTRAN -* -* Do for each value of TRANS. -* - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -* Restore the matrix A. -* - CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT .AND. ITRAN.EQ.1 ) THEN -* -* --- Test SGESV --- -* -* Compute the LU factorization of the matrix and -* solve the system. -* - CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) - CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'SGESV ' -c$$$ CALL CHAMELEON_SGESV_INCPIV( N, NRHS, AFAC, LDA, -c$$$ $ HL, HPIV, X, LDA, INFO ) - CALL CHAMELEON_SGESV( N, NRHS, AFAC, LDA, - $ IWORK, X, LDA, INFO ) -* -* Check error code from SGESV . -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'SGESV ', INFO, IZERO, - $ ' ', N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) -* - IF( IZERO.EQ.0 ) THEN -* -* Compute residual of the computed solution. -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL SGET02( 'No transpose', N, N, NRHS, A, - $ LDA, X, LDA, WORK, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Check solution from generated exact solution. -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 2 ) ) - NT = 2 - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'SGESV ', N, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT - END IF - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =', - $ G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', type ', I2, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', - $ G12.5 ) - RETURN -* -* End of SDRVGE -* - END diff --git a/testing/lin/sdrvls.f b/testing/lin/sdrvls.f deleted file mode 100644 index 43c77cb0e69af286415d1fc58724e072eb4dc9fe..0000000000000000000000000000000000000000 --- a/testing/lin/sdrvls.f +++ /dev/null @@ -1,405 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, IBVAL, WORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NN, NNB, NNS, NOUT - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ NVAL( * ), NXVAL( * ), IBVAL( * ) - REAL A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ COPYS( * ), S( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* SDRVLS tests the least squares driver routines SGELS, SGELSS, SGELSX, -* SGELSY and SGELSD. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* The matrix of type j is generated as follows: -* j=1: A = U*D*V where U and V are random orthogonal matrices -* and D has random entries (> 0.1) taken from a uniform -* distribution (0,1). A is full rank. -* j=2: The same of 1, but A is scaled up. -* j=3: The same of 1, but A is scaled down. -* j=4: A = U*D*V where U and V are random orthogonal matrices -* and D has 3*min(M,N)/4 random entries (> 0.1) taken -* from a uniform distribution (0,1) and the remaining -* entries set to 0. A is rank-deficient. -* j=5: The same of 4, but A is scaled up. -* j=6: The same of 5, but A is scaled down. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NNB) -* The values of the inner block size IB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* A (workspace) REAL array, dimension (MMAX*NMAX) -* where MMAX is the maximum value of M in MVAL and NMAX is the -* maximum value of N in NVAL. -* -* COPYA (workspace) REAL array, dimension (MMAX*NMAX) -* -* B (workspace) REAL array, dimension (MMAX*NSMAX) -* where MMAX is the maximum value of M in MVAL and NSMAX is the -* maximum value of NRHS in NSVAL. -* -* COPYB (workspace) REAL array, dimension (MMAX*NSMAX) -* -* C (workspace) REAL array, dimension (MMAX*NSMAX) -* -* S (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* -* WORK (workspace) REAL array, -* dimension (MMAX*NMAX + 4*NMAX + MMAX). -* -* IWORK (workspace) INTEGER array, dimension (15*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 18 ) - INTEGER SMLSIZ - PARAMETER ( SMLSIZ = 25 ) - REAL ONE, TWO, ZERO - PARAMETER ( ONE = 1.0E0, TWO = 2.0E0, ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - CHARACTER TRANS - CHARACTER*3 PATH - INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, IB, - $ CHAMELEON_TRANS - INTEGER HT( 2 ) - REAL EPS, NORMA, NORMB, RCOND -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - REAL SASUM, SLAMCH, SQRT14, SQRT17 - EXTERNAL SASUM, SLAMCH, SQRT14, SQRT17 -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASVM, SAXPY, SERRLS, SGELS, - $ SGELSD, SGELSS, SGELSX, SGELSY, SGEMM, SLACPY, - $ SLARNV, SQRT13, SQRT15, SQRT16, SSCAL, - $ XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC INT, LOG, MAX, MIN, REAL, SQRT -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, IOUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, IOUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'LS' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE - EPS = SLAMCH( 'Epsilon' ) -* -* Threshold for rank estimation -* - RCOND = SQRT( EPS ) - ( SQRT( EPS )-EPS ) / 2 -* -* Test the error exits -* - CALL XLAENV( 2, 2 ) - CALL XLAENV( 9, SMLSIZ ) - IF( TSTERR ) - $ CALL SERRLS( PATH, NOUT ) -* -* Print the header if NM = 0 or NN = 0 and THRESH = 0. -* - IF( ( NM.EQ.0 .OR. NN.EQ.0 ) .AND. THRESH.EQ.ZERO ) - $ CALL ALAHD( NOUT, PATH ) - INFOT = 0 -* - DO 150 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* - DO 140 IN = 1, NN - N = NVAL( IN ) - MNMIN = MIN( M, N ) - LDB = MAX( 1, M, N ) -* - DO 130 INS = 1, NNS - NRHS = NSVAL( INS ) - NLVL = MAX( INT( LOG( MAX( ONE, REAL( MNMIN ) ) / - $ REAL( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1, 0 ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ - $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2 ) -* - DO 120 IRANK = 1, 2 - DO 110 ISCALE = 1, 3 - ITYPE = ( IRANK-1 )*3 + ISCALE - IF( .NOT.DOTYPE( ITYPE ) ) - $ GO TO 110 -* - IF( IRANK.EQ.1 ) THEN -* -* Test SGELS -* -* Generate a matrix of scaling type ISCALE -* - CALL SQRT13( ISCALE, M, N, COPYA, LDA, NORMA, - $ ISEED ) - DO 40 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - CALL XLAENV( 3, NXVAL( INB ) ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 40 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, - $ INFO ) -* -* Allocate T -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGELS( M, N , HT, - $ INFO ) -* -* DO 30 ITRAN = 1, 2 - DO 30 ITRAN = 1, 1 -* -* ONLY CHAMELEONNOTRANS supported ! -* -* - IF( ITRAN.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - NROWS = M - NCOLS = N - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - NROWS = N - NCOLS = M - END IF - LDWORK = MAX( 1, NCOLS ) -* -* Set up a consistent rhs -* - IF( NCOLS.GT.0 ) THEN - CALL SLARNV( 2, ISEED, NCOLS*NRHS, - $ WORK ) - CALL SSCAL( NCOLS*NRHS, - $ ONE / REAL( NCOLS ), WORK, - $ 1 ) - END IF - CALL SGEMM( TRANS, 'No transpose', NROWS, - $ NRHS, NCOLS, ONE, COPYA, LDA, - $ WORK, LDWORK, ZERO, B, LDB ) - CALL SLACPY( 'Full', NROWS, NRHS, B, LDB, - $ COPYB, LDB ) -* -* Solve LS or overdetermined system -* - IF( M.GT.0 .AND. N.GT.0 ) THEN - CALL SLACPY( 'Full', M, N, COPYA, LDA, - $ A, LDA ) - CALL SLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, B, LDB ) - END IF - SRNAMT = 'SGELS ' -* - CALL CHAMELEON_SGELS( CHAMELEON_TRANS, - $ M, N, NRHS, - $ A, LDA, HT, B, LDB, - $ INFO ) - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'SGELS ', INFO, 0, - $ TRANS, M, N, NRHS, -1, NB, - $ ITYPE, NFAIL, NERRS, - $ NOUT ) -* -* Check correctness of results -* - LDWORK = MAX( 1, NROWS ) - IF( NROWS.GT.0 .AND. NRHS.GT.0 ) - $ CALL SLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, C, LDB ) - CALL SQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, WORK, - $ RESULT( 1 ) ) -* - IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. - $ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN -* -* Solving LS system -* - RESULT( 2 ) = SQRT17( TRANS, 1, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ COPYB, LDB, C, WORK, - $ LWORK ) - ELSE -* -* Solving overdetermined system -* - RESULT( 2 ) = SQRT14( TRANS, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ WORK, LWORK ) - END IF -* -* Print information about the tests that -* did not pass the threshold. -* - DO 20 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )TRANS, M, - $ N, NRHS, NB, ITYPE, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + 2 - 30 CONTINUE -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 40 CONTINUE - END IF - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - 150 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) - 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, - $ ', type', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of SDRVLS -* - END diff --git a/testing/lin/sdrvpo.f b/testing/lin/sdrvpo.f deleted file mode 100644 index fe1d0957025231eddeb1747d487f05e6e87b632c..0000000000000000000000000000000000000000 --- a/testing/lin/sdrvpo.f +++ /dev/null @@ -1,563 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - REAL THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - REAL A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), - $ X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* SDRVPO tests the driver routines SPOSV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) REAL -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) REAL array, dimension (NMAX*NMAX) -* -* AFAC (workspace) REAL array, dimension (NMAX*NMAX) -* -* ASAV (workspace) REAL array, dimension (NMAX*NMAX) -* -* B (workspace) REAL array, dimension (NMAX*NRHS) -* -* BSAV (workspace) REAL array, dimension (NMAX*NRHS) -* -* X (workspace) REAL array, dimension (NMAX*NRHS) -* -* XACT (workspace) REAL array, dimension (NMAX*NRHS) -* -* S (workspace) REAL array, dimension (NMAX) -* -* WORK (workspace) REAL array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) REAL array, dimension (NMAX+2*NRHS) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 6 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, ZEROT - CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, - $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, - $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, - $ CHAMELEON_UPLO - REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, - $ ROLDC, SCOND -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_UPLOS( 2 ) - REAL RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SGET06, SLANSY - EXTERNAL LSAME, SGET06, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY, - $ SLAQSY, SLARHS, SLASET, SLATB4, SLATMS, SPOEQU, - $ SPOSV, SPOSVX, SPOT01, SPOT02, SPOT05, SPOTRF, - $ SPOTRI, XLAENV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'Y' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Single precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL SERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Do for each value of N in NVAL -* - DO 130 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - DO 120 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 120 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 120 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 110 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with SLATB4 and generate a test matrix -* with SLATMS. -* - CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'SLATMS' - CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from SLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 110 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL SLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) -* - DO 100 IEQUED = 1, 2 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 90 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 90 - RCONDC = ZERO -* - ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN -* -* Compute the condition number for comparison with -* the value returned by SPOSVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL SLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL SPOEQU( N, AFAC, LDA, S, SCOND, AMAX, - $ INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( IEQUED.GT.1 ) - $ SCOND = ZERO -* -* Equilibrate the matrix. -* - CALL SLAQSY( UPLO, N, AFAC, LDA, S, SCOND, - $ AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the -* non-equilibrated system for use in SGET04. -* - IF( EQUIL ) - $ ROLDC = RCONDC -* -* Compute the 1-norm of A. -* - ANORM = SLANSY( '1', UPLO, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* - CALL CHAMELEON_SPOTRF( CHAMELEON_UPLO, N, - $ AFAC, LDA, INFO ) -* -* Form the inverse of A. -* - CALL SLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) - CALL CHAMELEON_SPOTRI( CHAMELEON_UPLO, N, A, LDA, - $ INFO ) -* -* Compute the 1-norm condition number of A. -* - AINVNM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCONDC = ONE - ELSE - RCONDC = ( ONE / ANORM ) / AINVNM - END IF - END IF -* -* Restore the matrix A. -* - CALL SLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'SLARHS' - CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT ) THEN -* -* --- Test SPOSV --- -* -* Compute the L*L' or U'*U factorization of the -* matrix and solve the system. -* - CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'SPOSV ' - CALL CHAMELEON_SPOSV( CHAMELEON_UPLO, N, NRHS, - $ AFAC, LDA, X, LDA, INFO ) -* -* Check error code from SPOSV . -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'SPOSV ', INFO, IZERO, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - GO TO 70 - ELSE IF( INFO.NE.0 ) THEN - GO TO 70 - END IF -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Compute residual of the computed solution. -* - CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 -* -* Print information about the tests that did not -* pass the threshold. -* - DO 60 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'SPOSV ', UPLO, - $ N, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + NT - 70 CONTINUE - END IF -* -* --- Test SPOSVX --- -* - IF( .NOT.PREFAC ) - $ CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) - CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) - IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN -* -* Equilibrate the matrix if FACT='F' and -* EQUED='Y'. -* - CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, - $ EQUED ) - END IF -* -* Solve the system and compute the condition number -* and error bounds using SPOSVX. -* - SRNAMT = 'SPOSVX' - CALL SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, - $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, - $ RWORK, RWORK( NRHS+1 ), WORK, IWORK, - $ INFO ) -* -* Check the error code from SPOSVX. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'SPOSVX', INFO, IZERO, - $ FACT // UPLO, N, N, -1, -1, NRHS, - $ IMAT, NFAIL, NERRS, NOUT ) - GO TO 90 - END IF -* - IF( INFO.EQ.0 ) THEN - IF( .NOT.PREFAC ) THEN -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA, - $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) - K1 = 1 - ELSE - K1 = 2 - END IF -* -* Compute residual of the computed solution. -* - CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, - $ LDA ) - CALL SPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, - $ WORK, LDA, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, - $ 'N' ) ) ) THEN - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 3 ) ) - ELSE - CALL SGET04( N, NRHS, X, LDA, XACT, LDA, - $ ROLDC, RESULT( 3 ) ) - END IF -* -* Check the error bounds from iterative -* refinement. -* - CALL SPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, - $ X, LDA, XACT, LDA, RWORK, - $ RWORK( NRHS+1 ), RESULT( 4 ) ) - ELSE - K1 = 6 - END IF -* -* Compare RCOND from SPOSVX with the computed value -* in RCONDC. -* - RESULT( 6 ) = SGET06( RCOND, RCONDC ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 80 K = K1, 6 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - IF( PREFAC ) THEN - WRITE( NOUT, FMT = 9997 )'SPOSVX', FACT, - $ UPLO, N, EQUED, IMAT, K, RESULT( K ) - ELSE - WRITE( NOUT, FMT = 9998 )'SPOSVX', FACT, - $ UPLO, N, IMAT, K, RESULT( K ) - END IF - NFAIL = NFAIL + 1 - END IF - 80 CONTINUE - NRUN = NRUN + 7 - K1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, - $ ', test(', I1, ')=', G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', type ', I1, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', - $ G12.5 ) - RETURN -* -* End of SDRVPO -* - END diff --git a/testing/lin/serrge.f b/testing/lin/serrge.f deleted file mode 100644 index aebe3d7a9d4264bae590e29e3af237b9772149b5..0000000000000000000000000000000000000000 --- a/testing/lin/serrge.f +++ /dev/null @@ -1,236 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRGE( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRGE tests the error exits for the REAL routines -* for general matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX, LW - PARAMETER ( NMAX = 4, LW = 3*NMAX ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL ANRM, CCOND, RCOND -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ), IW( NMAX ) - INTEGER HL( 2 ), HPIV( 2 ) - REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SGBCON, SGBEQU, SGBRFS, SGBTF2, - $ SGBTRF, SGBTRS, SGECON, SGEEQU, SGERFS, SGETF2, - $ SGETRF, SGETRI, SGETRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1. / REAL( I+J ) - AF( I, J ) = 1. / REAL( I+J ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - IP( J ) = J - IW( J ) = J - 20 CONTINUE - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE L and IPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* Test error exits of the routines that use the LU decomposition -* of a general matrix. -* -* SGETRF -* - SRNAMT = 'SGETRF' - INFOT = 1 - CALL CHAMELEON_SGETRF_INCPIV( -1, 0, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGETRF_INCPIV( 0, -1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGETRF_INCPIV( 2, 1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) -* -* SGETRS -* - SRNAMT = 'SGETRS' - INFOT = 103 - CALL CHAMELEON_SGETRS_INCPIV( '/', -1, 0, A, 1, HL, HPIV, - $ B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGETRS_INCPIV( CHAMELEONNOTRANS, -1, 0, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SGETRS_INCPIV( CHAMELEONNOTRANS, 0, -1, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 1, HL, - $ HPIV, B, 2, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_SGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 2, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE L and IPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* LAPACK Interface -* SGETRF -* - SRNAMT = 'SGETRF' - INFOT = 1 - CALL CHAMELEON_SGETRF( -1, 0, A, 1, IP, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGETRF( 0, -1, A, 1, IP, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGETRF( 2, 1, A, 1, IP, INFO ) - CALL CHKXER( 'SGETRF', INFOT, NOUT, INFO, OK ) -* -* SGETRS -* - SRNAMT = 'SGETRS' - INFOT = 1 - CALL CHAMELEON_SGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGETRS( CHAMELEONNOTRANS, -1, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SGETRS( CHAMELEONNOTRANS, 0, -1, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SGETRS( CHAMELEONNOTRANS, 2, 1, A, 1, IP, - $ B, 2, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_SGETRS( CHAMELEONNOTRANS, 2, 1, A, 2, IP, - $ B, 1, INFO ) - CALL CHKXER( 'SGETRS', INFOT, NOUT, INFO, OK ) - - ENDIF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRGE -* - END diff --git a/testing/lin/serrlq.f b/testing/lin/serrlq.f deleted file mode 100644 index 8e7c3c6216e15c11d5059a4f95254608dc189842..0000000000000000000000000000000000000000 --- a/testing/lin/serrlq.f +++ /dev/null @@ -1,247 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRLQ( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRLQ tests the error exits for the REAL routines -* that use the LQ decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SGELQ2, SGELQF, SORGL2, - $ SORGLQ, SORML2, SORMLQ -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1. / REAL( I+J ) - AF( I, J ) = 1. / REAL( I+J ) - 10 CONTINUE - B( J ) = 0. - W( J ) = 0. - X( J ) = 0. - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGELQF( 2, 2, HT, INFO ) -* -* Error exits for LQ factorization -* -* SGELQF -* - SRNAMT = 'SGELQF' - INFOT = 1 - CALL CHAMELEON_SGELQF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'SGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGELQF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'SGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGELQF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'SGELQF', INFOT, NOUT, INFO, OK ) -* -* SGELQS -* - SRNAMT = 'SGELQS' - INFOT = 1 - CALL CHAMELEON_SGELQS( -1, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGELQS( 0, -1, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGELQS( 2, 1, 0, A, 2, HT, B, 1, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SGELQS( 0, 0, -1, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SGELQS( 2, 2, 0, A, 1, HT, B, 2, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_SGELQS( 1, 2, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'SGELQS', INFOT, NOUT, INFO, OK ) -* -* SORGLQ -* - SRNAMT = 'SORGLQ' - INFOT = 1 - CALL CHAMELEON_SORGLQ( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORGLQ( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORGLQ( 2, 1, 0, A, 2, HT, W, 2, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORGLQ( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORGLQ( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SORGLQ( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_SORGLQ( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'SORGLQ', INFOT, NOUT, INFO, OK ) -* -* SORMLQ -* - SRNAMT = 'SORMLQ' - INFOT = 1 - CALL CHAMELEON_SORMLQ( '/', CHAMELEONTRANS, 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, -1, 0, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, -1, 0, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, 0, -1, A, 1, HT, - $ AF, 1, INFO ) - CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 0, 1, 1, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_SORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 1, 0, 1, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 2, 0, 2, A, 1, HT, AF, 2, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_SORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 0, 2, 2, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 2, HT, AF, 1, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_SORMLQ( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, AF, 1, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_SORMLQ( CHAMELEONRIGHT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, AF, 2, INFO ) -* CALL CHKXER( 'SORMLQ', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRLQ -* - END diff --git a/testing/lin/serrls.f b/testing/lin/serrls.f deleted file mode 100644 index 0602e5270bb08f75aa5fbd1a4e09c4c60060e861..0000000000000000000000000000000000000000 --- a/testing/lin/serrls.f +++ /dev/null @@ -1,166 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRLS( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRLS tests the error exits for the REAL least squares -* driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER INFO, IRNK - REAL RCOND - INTEGER HT( 2 ) -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - REAL A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ), - $ W( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSX, - $ SGELSY -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) - A( 1, 1 ) = 1.0E+0 - A( 1, 2 ) = 2.0E+0 - A( 2, 2 ) = 3.0E+0 - A( 2, 1 ) = 4.0E+0 - OK = .TRUE. -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* - IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* Test error exits for the least squares driver routines. -* -* SGELS -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGELS( 2, 2, HT, INFO ) -* - SRNAMT = 'SGELS ' - INFOT = 103 - CALL CHAMELEON_SGELS( '/', 0, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGELS( CHAMELEONNOTRANS, -1, 0, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SGELS( CHAMELEONNOTRANS, 0, -1, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGELS( CHAMELEONNOTRANS, 0, 0, -1, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL CHAMELEON_SGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 1, HT, - $ B, 2, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_SGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 2, HT, - $ B, 1, INFO ) - CALL CHKXER( 'SGELS ', INFOT, NOUT, INFO, OK ) -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRLS -* - END diff --git a/testing/lin/serrpo.f b/testing/lin/serrpo.f deleted file mode 100644 index ce256a6f1ae5cbd22098154cd2059dbd4732b8d0..0000000000000000000000000000000000000000 --- a/testing/lin/serrpo.f +++ /dev/null @@ -1,182 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRPO( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRPO tests the error exits for the REAL routines -* for symmetric positive definite matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL ANRM, RCOND -* .. -* .. Local Arrays .. - INTEGER IW( NMAX ) - REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SPBCON, SPBEQU, SPBRFS, SPBTF2, - $ SPBTRF, SPBTRS, SPOCON, SPOEQU, SPORFS, SPOTF2, - $ SPOTRF, SPOTRI, SPOTRS, SPPCON, SPPEQU, SPPRFS, - $ SPPTRF, SPPTRI, SPPTRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1. / REAL( I+J ) - AF( I, J ) = 1. / REAL( I+J ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - IW( J ) = J - 20 CONTINUE - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* Test error exits of the routines that use the Cholesky -* decomposition of a symmetric positive definite matrix. -* -* SPOTRF -* - SRNAMT = 'SPOTRF' - INFOT = 1 - CALL CHAMELEON_SPOTRF( '/', 0, A, 1, INFO ) - CALL CHKXER( 'SPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SPOTRF( CHAMELEONUPPER, -1, A, 1, INFO ) - CALL CHKXER( 'SPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SPOTRF( CHAMELEONUPPER, 2, A, 1, INFO ) - CALL CHKXER( 'SPOTRF', INFOT, NOUT, INFO, OK ) -* -* SPOTRS -* - SRNAMT = 'SPOTRS' - INFOT = 1 - CALL CHAMELEON_SPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SPOTRS( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SPOTRS( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SPOTRS( CHAMELEONUPPER, 2, 1, A, 1, B, 2, INFO ) - CALL CHKXER( 'SPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_SPOTRS( CHAMELEONUPPER, 2, 1, A, 2, B, 1, INFO ) - CALL CHKXER( 'SPOTRS', INFOT, NOUT, INFO, OK ) - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRPO -* - END diff --git a/testing/lin/serrqr.f b/testing/lin/serrqr.f deleted file mode 100644 index e1e110e4814b45a9e2b9aa3e5ce3673792371bb6..0000000000000000000000000000000000000000 --- a/testing/lin/serrqr.f +++ /dev/null @@ -1,252 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRQR( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRQR tests the error exits for the REAL routines -* that use the QR decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, SGEQR2, SGEQRF, SORG2R, - $ SORGQR, SORM2R, SORMQR -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1. / REAL( I+J ) - AF( I, J ) = 1. / REAL( I+J ) - 10 CONTINUE - B( J ) = 0. - W( J ) = 0. - X( J ) = 0. - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGEQRF( 2, 2, HT, INFO ) - -* -* Error exits for QR factorization -* -* SGEQRF -* - SRNAMT = 'SGEQRF' - INFOT = 1 - CALL CHAMELEON_SGEQRF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'SGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGEQRF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'SGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGEQRF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'SGEQRF', INFOT, NOUT, INFO, OK ) -* -* SGEQRS -* -* - SRNAMT = 'SGEQRS' - INFOT = 1 - CALL CHAMELEON_SGEQRS( -1, 0, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGEQRS( 0, -1, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGEQRS( 1, 2, 0, A, 2, X, B, 2, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SGEQRS( 0, 0, -1, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SGEQRS( 2, 1, 0, A, 1, X, B, 2, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_SGEQRS( 2, 1, 0, A, 2, X, B, 1, INFO ) - CALL CHKXER( 'SGEQRS', INFOT, NOUT, INFO, OK ) -* -* SORGQR -* - SRNAMT = 'SORGQR' - INFOT = 1 - CALL CHAMELEON_SORGQR( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORGQR( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORGQR( 1, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORGQR( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORGQR( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SORGQR( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_SORGQR( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'SORGQR', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_SORMQR -* - SRNAMT = 'SORMQR' - INFOT = 1 - CALL CHAMELEON_SORMQR( '/', CHAMELEONTRANS, 0, 0, 0, A, 1, HT, AF, 1, - 4 INFO ) - CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SORMQR( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - 4 INFO ) - CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, -1, 0, 0, A, 1, HT, - 4 AF, 1, INFO ) - CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, -1, 0, A, 1, HT, - 4 AF, 1, INFO ) - CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, 0, -1, A, 1, HT, - 4 AF, 1, INFO ) - CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 0, 1, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 0, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_SORMQR( CHAMELEONLEFT, CHAMELEONTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'SORMQR', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRQR -* - END diff --git a/testing/lin/serrvx.f b/testing/lin/serrvx.f deleted file mode 100644 index 66bf68c5851d48e484736c87ef70daf699a7aaf4..0000000000000000000000000000000000000000 --- a/testing/lin/serrvx.f +++ /dev/null @@ -1,271 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SERRVX( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* SERRVX tests the error exits for the REAL driver routines -* for solving linear systems of equations. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER EQ - CHARACTER*2 C2 - INTEGER I, INFO, J - REAL RCOND -* .. -* .. Local Arrays .. - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER IP( NMAX ), IW( NMAX ) - REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL CHKXER, SGBSV, SGBSVX, SGESV, SGESVX, SGTSV, - $ SGTSVX, SPBSV, SPBSVX, SPOSV, SPOSVX, SPPSV, - $ SPPSVX, SPTSV, SPTSVX, SSPSV, SSPSVX, SSYSV, - $ SSYSVX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = 1. / REAL( I+J ) - AF( I, J ) = 1. / REAL( I+J ) - 10 CONTINUE - B( J ) = 0. - R1( J ) = 0. - R2( J ) = 0. - W( J ) = 0. - X( J ) = 0. - C( J ) = 0. - R( J ) = 0. - IP( J ) = J - 20 CONTINUE - EQ = ' ' - OK = .TRUE. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE HL and HPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_SGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* CHAMELEON_SGESV -* - SRNAMT = 'SGESV ' - INFOT = 1 - CALL CHAMELEON_SGESV_INCPIV( -1, 0, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGESV_INCPIV( 0, -1, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGESV_INCPIV( 2, 1, A, 1, HL, HPIV, B, 2, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_SGESV_INCPIV( 2, 1, A, 2, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE HL and HPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* -* SGESV -* - SRNAMT = 'SGESV ' - INFOT = 1 - CALL CHAMELEON_SGESV( -1, 0, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SGESV( 0, -1, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_SGESV( 2, 1, A, 1, IWORK, B, 2, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_SGESV( 2, 1, A, 2, IWORK, B, 1, INFO ) - CALL CHKXER( 'SGESV ', INFOT, NOUT, INFO, OK ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* SPOSV -* - SRNAMT = 'SPOSV ' - INFOT = 1 - CALL CHAMELEON_SPOSV( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_SPOSV( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_SPOSV( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'SPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_SPOSV( CHAMELEONUPPER, 2, 0, A, 1, B, 2, INFO ) - CALL CHKXER( 'SPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_SPOSV( CHAMELEONUPPER, 2, 0, A, 2, B, 1, INFO ) - CALL CHKXER( 'SPOSV ', INFOT, NOUT, INFO, OK ) -* -* SPOSVX -* - SRNAMT = 'SPOSVX' - INFOT = 1 - CALL SPOSVX( '/', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL SPOSVX( 'N', '/', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL SPOSVX( 'N', 'U', -1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL SPOSVX( 'N', 'U', 0, -1, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL SPOSVX( 'N', 'U', 2, 0, A, 1, AF, 2, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL SPOSVX( 'N', 'U', 2, 0, A, 2, AF, 1, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 9 - EQ = '/' - CALL SPOSVX( 'F', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 10 - EQ = 'Y' - CALL SPOSVX( 'F', 'U', 1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 12 - CALL SPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 1, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 14 - CALL SPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 2, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'SPOSVX', INFOT, NOUT, INFO, OK ) - END IF -* -* Print a summary line. -* - IF( OK ) THEN - WRITE( NOUT, FMT = 9999 )PATH - ELSE - WRITE( NOUT, FMT = 9998 )PATH - END IF -* - 9999 FORMAT( 1X, A3, ' drivers passed the tests of the error exits' ) - 9998 FORMAT( ' *** ', A3, ' drivers failed the tests of the error ', - $ 'exits ***' ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of SERRVX -* - END diff --git a/testing/lin/sgeequ.f b/testing/lin/sgeequ.f deleted file mode 100644 index 5138d67b54bf204494d9125d3555c84a5e076cb7..0000000000000000000000000000000000000000 --- a/testing/lin/sgeequ.f +++ /dev/null @@ -1,262 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, M, N - REAL AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - REAL A( LDA, * ), C( * ), R( * ) -* .. -* -* Purpose -* ======= -* -* SGEEQU computes row and column scalings intended to equilibrate an -* M-by-N matrix A and reduce its condition number. R returns the row -* scale factors and C the column scale factors, chosen to try to make -* the largest element in each row and column of the matrix B with -* elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1. -* -* R(i) and C(j) are restricted to be between SMLNUM = smallest safe -* number and BIGNUM = largest safe number. Use of these scaling -* factors is not guaranteed to reduce the condition number of A but -* works well in practice. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The M-by-N matrix whose equilibration factors are -* to be computed. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* R (output) REAL array, dimension (M) -* If INFO = 0 or INFO > M, R contains the row scale factors -* for A. -* -* C (output) REAL array, dimension (N) -* If INFO = 0, C contains the column scale factors for A. -* -* ROWCND (output) REAL -* If INFO = 0 or INFO > M, ROWCND contains the ratio of the -* smallest R(i) to the largest R(i). If ROWCND >= 0.1 and -* AMAX is neither too large nor too small, it is not worth -* scaling by R. -* -* COLCND (output) REAL -* If INFO = 0, COLCND contains the ratio of the smallest -* C(i) to the largest C(i). If COLCND >= 0.1, it is not -* worth scaling by C. -* -* AMAX (output) REAL -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= M: the i-th row of A is exactly zero -* > M: the (i-M)-th column of A is exactly zero -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL BIGNUM, RCMAX, RCMIN, SMLNUM -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SGEEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) THEN - ROWCND = ONE - COLCND = ONE - AMAX = ZERO - RETURN - END IF -* -* Get machine constants. -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* -* Compute row scale factors. -* - DO 10 I = 1, M - R( I ) = ZERO - 10 CONTINUE -* -* Find the maximum element in each row. -* - DO 30 J = 1, N - DO 20 I = 1, M - R( I ) = MAX( R( I ), ABS( A( I, J ) ) ) - 20 CONTINUE - 30 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 40 I = 1, M - RCMAX = MAX( RCMAX, R( I ) ) - RCMIN = MIN( RCMIN, R( I ) ) - 40 CONTINUE - AMAX = RCMAX -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 50 I = 1, M - IF( R( I ).EQ.ZERO ) THEN - INFO = I - RETURN - END IF - 50 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 60 I = 1, M - R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) - 60 CONTINUE -* -* Compute ROWCND = min(R(I)) / max(R(I)) -* - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* -* Compute column scale factors -* - DO 70 J = 1, N - C( J ) = ZERO - 70 CONTINUE -* -* Find the maximum element in each column, -* assuming the row scaling computed above. -* - DO 90 J = 1, N - DO 80 I = 1, M - C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) ) - 80 CONTINUE - 90 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 100 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 100 CONTINUE -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 110 J = 1, N - IF( C( J ).EQ.ZERO ) THEN - INFO = M + J - RETURN - END IF - 110 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 120 J = 1, N - C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) - 120 CONTINUE -* -* Compute COLCND = min(C(J)) / max(C(J)) -* - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* - RETURN -* -* End of SGEEQU -* - END diff --git a/testing/lin/sgennd.f b/testing/lin/sgennd.f deleted file mode 100644 index cea5cca497a92cf123d2d4182e24002cca48048f..0000000000000000000000000000000000000000 --- a/testing/lin/sgennd.f +++ /dev/null @@ -1,94 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - LOGICAL FUNCTION SGENND (M, N, A, LDA) - IMPLICIT NONE -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* February 2008 -* -* .. Scalar Arguments .. - INTEGER M, N, LDA -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SGENND tests that its argument has a non-negative diagonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows in A. -* -* N (input) INTEGER -* The number of columns in A. -* -* A (input) REAL array, dimension (LDA, N) -* The matrix. -* -* LDA (input) INTEGER -* Leading dimension of A. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - INTEGER I, K -* .. -* .. Intrinsics .. - INTRINSIC MIN -* .. -* .. Executable Statements .. - K = MIN( M, N ) - DO I = 1, K - IF( A( I, I ).LT.ZERO ) THEN - SGENND = .FALSE. - RETURN - END IF - END DO - SGENND = .TRUE. - RETURN - END diff --git a/testing/lin/sget02.f b/testing/lin/sget02.f deleted file mode 100644 index dc71d2155c6c97184c1a213a32e97cf84e3c4068..0000000000000000000000000000000000000000 --- a/testing/lin/sget02.f +++ /dev/null @@ -1,183 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SGET02 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm(B - A*X) / ( (norm(A) * norm(X)+ norm(NRHS)) *N * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A'*x = b, where A' is the transpose of A -* = 'C': A'*x = b, where A' is the transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) REAL array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) REAL array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( (norm(A) * norm(X) +norm(RHS)) *N * EPS ). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - REAL ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SASUM, SLAMCH, SLANGE - EXTERNAL LSAME, SASUM, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - N1 = N - N2 = M - ELSE - N1 = M - N2 = N - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = SLANGE( '1', N1, N2, A, LDA, RWORK ) - RHSNORM = SLANGE( '1', N1, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL SGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, - $ LDX, ONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SASUM( N1, B( 1, J ), 1 ) - XNORM = SASUM( N2, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( ( BNORM )/ (ANORM * XNORM + RHSNORM) * - $ N1 * EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of SGET02 -* - END diff --git a/testing/lin/sget04.f b/testing/lin/sget04.f deleted file mode 100644 index 7ad4ee9490d7dac54ddd846ff863d34248cf7581..0000000000000000000000000000000000000000 --- a/testing/lin/sget04.f +++ /dev/null @@ -1,154 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDX, LDXACT, N, NRHS - REAL RCOND, RESID -* .. -* .. Array Arguments .. - REAL X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* SGET04 computes the difference between a computed solution and the -* true solution to a system of linear equations. -* -* RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), -* where RCOND is the reciprocal of the condition number and EPS is the -* machine epsilon. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of rows of the matrices X and XACT. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and XACT. NRHS >= 0. -* -* X (input) REAL array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) REAL array, dimension( LDX, NRHS ) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* RCOND (input) REAL -* The reciprocal of the condition number of the coefficient -* matrix in the system of equations. -* -* RESID (output) REAL -* The maximum over the NRHS solution vectors of -* ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, IX, J - REAL DIFFNM, EPS, XNORM -* .. -* .. External Functions .. - INTEGER ISAMAX - REAL SLAMCH - EXTERNAL ISAMAX, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if RCOND is invalid. -* - EPS = SLAMCH( 'Epsilon' ) - IF( RCOND.LT.ZERO ) THEN - RESID = 1.0 / EPS - RETURN - END IF -* -* Compute the maximum of -* norm(X - XACT) / ( norm(XACT) * EPS ) -* over all the vectors X and XACT . -* - RESID = ZERO - DO 20 J = 1, NRHS - IX = ISAMAX( N, XACT( 1, J ), 1 ) - XNORM = ABS( XACT( IX, J ) ) - DIFFNM = ZERO - DO 10 I = 1, N - DIFFNM = MAX( DIFFNM, ABS( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE - IF( XNORM.LE.ZERO ) THEN - IF( DIFFNM.GT.ZERO ) - $ RESID = 1.0 / EPS - ELSE - RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) - END IF - 20 CONTINUE - IF( RESID*EPS.LT.1.0 ) - $ RESID = RESID / EPS -* - RETURN -* -* End of SGET04 -* - END diff --git a/testing/lin/sget06.f b/testing/lin/sget06.f deleted file mode 100644 index b160c4e0c3cceab750444d83f5dfb5f838e24d5a..0000000000000000000000000000000000000000 --- a/testing/lin/sget06.f +++ /dev/null @@ -1,102 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SGET06( RCOND, RCONDC ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - REAL RCOND, RCONDC -* .. -* -* Purpose -* ======= -* -* SGET06 computes a test ratio to compare two values for RCOND. -* -* Arguments -* ========== -* -* RCOND (input) REAL -* The estimate of the reciprocal of the condition number of A, -* as computed by SGECON. -* -* RCONDC (input) REAL -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(inv(A)). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - REAL EPS, RAT -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) - IF( RCOND.GT.ZERO ) THEN - IF( RCONDC.GT.ZERO ) THEN - RAT = MAX( RCOND, RCONDC ) / MIN( RCOND, RCONDC ) - - $ ( ONE-EPS ) - ELSE - RAT = RCOND / EPS - END IF - ELSE - IF( RCONDC.GT.ZERO ) THEN - RAT = RCONDC / EPS - ELSE - RAT = ZERO - END IF - END IF - SGET06 = RAT - RETURN -* -* End of SGET06 -* - END diff --git a/testing/lin/slabad.f b/testing/lin/slabad.f deleted file mode 100644 index 53270f65a168ee9ab82cf80a1e05e13bc041b85f..0000000000000000000000000000000000000000 --- a/testing/lin/slabad.f +++ /dev/null @@ -1,92 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLABAD( SMALL, LARGE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - REAL LARGE, SMALL -* .. -* -* Purpose -* ======= -* -* SLABAD takes as input the values computed by SLAMCH for underflow and -* overflow, and returns the square root of each of these values if the -* log of LARGE is sufficiently large. This subroutine is intended to -* identify machines with a large exponent range, such as the Crays, and -* redefine the underflow and overflow limits to be the square roots of -* the values computed by SLAMCH. This subroutine is needed because -* SLAMCH does not compensate for poor arithmetic in the upper half of -* the exponent range, as is found on a Cray. -* -* Arguments -* ========= -* -* SMALL (input/output) REAL -* On entry, the underflow threshold as computed by SLAMCH. -* On exit, if LOG10(LARGE) is sufficiently large, the square -* root of SMALL, otherwise unchanged. -* -* LARGE (input/output) REAL -* On entry, the overflow threshold as computed by SLAMCH. -* On exit, if LOG10(LARGE) is sufficiently large, the square -* root of LARGE, otherwise unchanged. -* -* ===================================================================== -* -* .. Intrinsic Functions .. - INTRINSIC LOG10, SQRT -* .. -* .. Executable Statements .. -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - IF( LOG10( LARGE ).GT.2000. ) THEN - SMALL = SQRT( SMALL ) - LARGE = SQRT( LARGE ) - END IF -* - RETURN -* -* End of SLABAD -* - END diff --git a/testing/lin/slacn2.f b/testing/lin/slacn2.f deleted file mode 100644 index 1afb5114bdb17bd1d513b9ffc898b69f594f0a48..0000000000000000000000000000000000000000 --- a/testing/lin/slacn2.f +++ /dev/null @@ -1,251 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLACN2( N, V, X, ISGN, EST, KASE, ISAVE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER KASE, N - REAL EST -* .. -* .. Array Arguments .. - INTEGER ISGN( * ), ISAVE( 3 ) - REAL V( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* SLACN2 estimates the 1-norm of a square, real matrix A. -* Reverse communication is used for evaluating matrix-vector products. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix. N >= 1. -* -* V (workspace) REAL array, dimension (N) -* On the final return, V = A*W, where EST = norm(V)/norm(W) -* (W is not returned). -* -* X (input/output) REAL array, dimension (N) -* On an intermediate return, X should be overwritten by -* A * X, if KASE=1, -* A' * X, if KASE=2, -* and SLACN2 must be re-called with all the other parameters -* unchanged. -* -* ISGN (workspace) INTEGER array, dimension (N) -* -* EST (input/output) REAL -* On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be -* unchanged from the previous call to SLACN2. -* On exit, EST is an estimate (a lower bound) for norm(A). -* -* KASE (input/output) INTEGER -* On the initial call to SLACN2, KASE should be 0. -* On an intermediate return, KASE will be 1 or 2, indicating -* whether X should be overwritten by A * X or A' * X. -* On the final return from SLACN2, KASE will again be 0. -* -* ISAVE (input/output) INTEGER array, dimension (3) -* ISAVE is used to save variables between calls to SLACN2 -* -* Further Details -* ======= ======= -* -* Contributed by Nick Higham, University of Manchester. -* Originally named SONEST, dated March 16, 1988. -* -* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of -* a real or complex matrix, with applications to condition estimation", -* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. -* -* This is a thread safe version of SLACON, which uses the array ISAVE -* in place of a SAVE statement, as follows: -* -* SLACON SLACN2 -* JUMP ISAVE(1) -* J ISAVE(2) -* ITER ISAVE(3) -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - REAL ZERO, ONE, TWO - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, JLAST - REAL ALTSGN, ESTOLD, TEMP -* .. -* .. External Functions .. - INTEGER ISAMAX - REAL SASUM - EXTERNAL ISAMAX, SASUM -* .. -* .. External Subroutines .. - EXTERNAL SCOPY -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, NINT, REAL, SIGN -* .. -* .. Executable Statements .. -* - IF( KASE.EQ.0 ) THEN - DO 10 I = 1, N - X( I ) = ONE / REAL( N ) - 10 CONTINUE - KASE = 1 - ISAVE( 1 ) = 1 - RETURN - END IF -* - GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 ) -* -* ................ ENTRY (ISAVE( 1 ) = 1) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. -* - 20 CONTINUE - IF( N.EQ.1 ) THEN - V( 1 ) = X( 1 ) - EST = ABS( V( 1 ) ) -* ... QUIT - GO TO 150 - END IF - EST = SASUM( N, X, 1 ) -* - DO 30 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) - ISGN( I ) = NINT( X( I ) ) - 30 CONTINUE - KASE = 2 - ISAVE( 1 ) = 2 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 2) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. -* - 40 CONTINUE - ISAVE( 2 ) = ISAMAX( N, X, 1 ) - ISAVE( 3 ) = 2 -* -* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. -* - 50 CONTINUE - DO 60 I = 1, N - X( I ) = ZERO - 60 CONTINUE - X( ISAVE( 2 ) ) = ONE - KASE = 1 - ISAVE( 1 ) = 3 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 3) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 70 CONTINUE - CALL SCOPY( N, X, 1, V, 1 ) - ESTOLD = EST - EST = SASUM( N, V, 1 ) - DO 80 I = 1, N - IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) ) - $ GO TO 90 - 80 CONTINUE -* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. - GO TO 120 -* - 90 CONTINUE -* TEST FOR CYCLING. - IF( EST.LE.ESTOLD ) - $ GO TO 120 -* - DO 100 I = 1, N - X( I ) = SIGN( ONE, X( I ) ) - ISGN( I ) = NINT( X( I ) ) - 100 CONTINUE - KASE = 2 - ISAVE( 1 ) = 4 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 4) -* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. -* - 110 CONTINUE - JLAST = ISAVE( 2 ) - ISAVE( 2 ) = ISAMAX( N, X, 1 ) - IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND. - $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN - ISAVE( 3 ) = ISAVE( 3 ) + 1 - GO TO 50 - END IF -* -* ITERATION COMPLETE. FINAL STAGE. -* - 120 CONTINUE - ALTSGN = ONE - DO 130 I = 1, N - X( I ) = ALTSGN*( ONE+REAL( I-1 ) / REAL( N-1 ) ) - ALTSGN = -ALTSGN - 130 CONTINUE - KASE = 1 - ISAVE( 1 ) = 5 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 5) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 140 CONTINUE - TEMP = TWO*( SASUM( N, X, 1 ) / REAL( 3*N ) ) - IF( TEMP.GT.EST ) THEN - CALL SCOPY( N, X, 1, V, 1 ) - EST = TEMP - END IF -* - 150 CONTINUE - KASE = 0 - RETURN -* -* End of SLACN2 -* - END diff --git a/testing/lin/slagge.f b/testing/lin/slagge.f deleted file mode 100644 index bd58605758223a849faa67be654a3843d84724c5..0000000000000000000000000000000000000000 --- a/testing/lin/slagge.f +++ /dev/null @@ -1,326 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, KL, KU, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* SLAGGE generates a real general m by n matrix A, by pre- and post- -* multiplying a real diagonal matrix D with random orthogonal matrices: -* A = U*D*V. The lower and upper bandwidths may then be reduced to -* kl and ku by additional orthogonal transformations. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= KL <= M-1. -* -* KU (input) INTEGER -* The number of nonzero superdiagonals within the band of A. -* 0 <= KU <= N-1. -* -* D (input) REAL array, dimension (min(M,N)) -* The diagonal elements of the diagonal matrix D. -* -* A (output) REAL array, dimension (LDA,N) -* The generated m by n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) REAL array, dimension (M+N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL TAU, WA, WB, WN -* .. -* .. External Subroutines .. - EXTERNAL SGEMV, SGER, SLARNV, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, SIGN -* .. -* .. External Functions .. - REAL SNRM2 - EXTERNAL SNRM2 -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN - INFO = -3 - ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -7 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'SLAGGE', -INFO ) - RETURN - END IF -* -* initialize A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = 1, M - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( M, N ) - A( I, I ) = D( I ) - 30 CONTINUE -* -* pre- and post-multiply A by random orthogonal matrices -* - DO 40 I = MIN( M, N ), 1, -1 - IF( I.LT.M ) THEN -* -* generate random reflection -* - CALL SLARNV( 3, ISEED, M-I+1, WORK ) - WN = SNRM2( M-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL SSCAL( M-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* multiply A(i:m,i:n) by random reflection from the left -* - CALL SGEMV( 'Transpose', M-I+1, N-I+1, ONE, A( I, I ), LDA, - $ WORK, 1, ZERO, WORK( M+1 ), 1 ) - CALL SGER( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1, - $ A( I, I ), LDA ) - END IF - IF( I.LT.N ) THEN -* -* generate random reflection -* - CALL SLARNV( 3, ISEED, N-I+1, WORK ) - WN = SNRM2( N-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* multiply A(i:m,i:n) by random reflection from the right -* - CALL SGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ), - $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 ) - CALL SGER( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, - $ A( I, I ), LDA ) - END IF - 40 CONTINUE -* -* Reduce number of subdiagonals to KL and number of superdiagonals -* to KU -* - DO 70 I = 1, MAX( M-1-KL, N-1-KU ) - IF( KL.LE.KU ) THEN -* -* annihilate subdiagonal elements first (necessary if KL = 0) -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = SNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = SIGN( WN, A( KL+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL SSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL SGEMV( 'Transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL SGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1, - $ A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = SNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = SIGN( WN, A( I, KU+I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL SSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL SGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL SGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF - ELSE -* -* annihilate superdiagonal elements first (necessary if -* KU = 0) -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = SNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = SIGN( WN, A( I, KU+I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL SSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL SGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL SGER( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = SNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = SIGN( WN, A( KL+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL SSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL SGEMV( 'Transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL SGER( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, 1, - $ A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF - END IF -* - DO 50 J = KL + I + 1, M - A( J, I ) = ZERO - 50 CONTINUE -* - DO 60 J = KU + I + 1, N - A( I, J ) = ZERO - 60 CONTINUE - 70 CONTINUE - RETURN -* -* End of SLAGGE -* - END diff --git a/testing/lin/slagsy.f b/testing/lin/slagsy.f deleted file mode 100644 index 966e1744dac6357dde09a51d5f06b18a872bef3a..0000000000000000000000000000000000000000 --- a/testing/lin/slagsy.f +++ /dev/null @@ -1,236 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, K, LDA, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* SLAGSY generates a real symmetric matrix A, by pre- and post- -* multiplying a real diagonal matrix D with a random orthogonal matrix: -* A = U*D*U'. The semi-bandwidth may then be reduced to k by additional -* orthogonal transformations. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* K (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= K <= N-1. -* -* D (input) REAL array, dimension (N) -* The diagonal elements of the diagonal matrix D. -* -* A (output) REAL array, dimension (LDA,N) -* The generated n by n symmetric matrix A (the full matrix is -* stored). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= N. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) REAL array, dimension (2*N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, HALF - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, HALF = 0.5E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL ALPHA, TAU, WA, WB, WN -* .. -* .. External Subroutines .. - EXTERNAL SAXPY, SGEMV, SGER, SLARNV, SSCAL, SSYMV, - $ SSYR2, XERBLA -* .. -* .. External Functions .. - REAL SDOT, SNRM2 - EXTERNAL SDOT, SNRM2 -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, SIGN -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'SLAGSY', -INFO ) - RETURN - END IF -* -* initialize lower triangle of A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = J + 1, N - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, N - A( I, I ) = D( I ) - 30 CONTINUE -* -* Generate lower triangle of symmetric matrix -* - DO 40 I = N - 1, 1, -1 -* -* generate random reflection -* - CALL SLARNV( 3, ISEED, N-I+1, WORK ) - WN = SNRM2( N-I+1, WORK, 1 ) - WA = SIGN( WN, WORK( 1 ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = WB / WA - END IF -* -* apply random reflection to A(i:n,i:n) from the left -* and the right -* -* compute y := tau * A * u -* - CALL SSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO, - $ WORK( N+1 ), 1 ) -* -* compute v := y - 1/2 * tau * ( y, u ) * u -* - ALPHA = -HALF*TAU*SDOT( N-I+1, WORK( N+1 ), 1, WORK, 1 ) - CALL SAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 ) -* -* apply the transformation as a rank-2 update to A(i:n,i:n) -* - CALL SSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1, - $ A( I, I ), LDA ) - 40 CONTINUE -* -* Reduce number of subdiagonals to K -* - DO 60 I = 1, N - 1 - K -* -* generate reflection to annihilate A(k+i+1:n,i) -* - WN = SNRM2( N-K-I+1, A( K+I, I ), 1 ) - WA = SIGN( WN, A( K+I, I ) ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( K+I, I ) + WA - CALL SSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 ) - A( K+I, I ) = ONE - TAU = WB / WA - END IF -* -* apply reflection to A(k+i:n,i+1:k+i-1) from the left -* - CALL SGEMV( 'Transpose', N-K-I+1, K-1, ONE, A( K+I, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL SGER( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1, - $ A( K+I, I+1 ), LDA ) -* -* apply reflection to A(k+i:n,k+i:n) from the left and the right -* -* compute y := tau * A * u -* - CALL SSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) -* -* compute v := y - 1/2 * tau * ( y, u ) * u -* - ALPHA = -HALF*TAU*SDOT( N-K-I+1, WORK, 1, A( K+I, I ), 1 ) - CALL SAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 ) -* -* apply symmetric rank-2 update to A(k+i:n,k+i:n) -* - CALL SSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1, - $ A( K+I, K+I ), LDA ) -* - A( K+I, I ) = -WA - DO 50 J = K + I + 1, N - A( J, I ) = ZERO - 50 CONTINUE - 60 CONTINUE -* -* Store full symmetric matrix -* - DO 80 J = 1, N - DO 70 I = J + 1, N - A( J, I ) = A( I, J ) - 70 CONTINUE - 80 CONTINUE - RETURN -* -* End of SLAGSY -* - END diff --git a/testing/lin/slaord.f b/testing/lin/slaord.f deleted file mode 100644 index 3de86aa71a9cfdfba935e40ec61c3decb3a57fbc..0000000000000000000000000000000000000000 --- a/testing/lin/slaord.f +++ /dev/null @@ -1,138 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAORD( JOB, N, X, INCX ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER JOB - INTEGER INCX, N -* .. -* .. Array Arguments .. - REAL X( * ) -* .. -* -* Purpose -* ======= -* -* SLAORD sorts the elements of a vector x in increasing or decreasing -* order. -* -* Arguments -* ========= -* -* JOB (input) CHARACTER -* = 'I': Sort in increasing order -* = 'D': Sort in decreasing order -* -* N (input) INTEGER -* The length of the vector X. -* -* X (input/output) REAL array, dimension -* (1+(N-1)*INCX) -* On entry, the vector of length n to be sorted. -* On exit, the vector x is sorted in the prescribed order. -* -* INCX (input) INTEGER -* The spacing between successive elements of X. INCX >= 0. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, INC, IX, IXNEXT - REAL TEMP -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* - INC = ABS( INCX ) - IF( LSAME( JOB, 'I' ) ) THEN -* -* Sort in increasing order -* - DO 20 I = 2, N - IX = 1 + ( I-1 )*INC - 10 CONTINUE - IF( IX.EQ.1 ) - $ GO TO 20 - IXNEXT = IX - INC - IF( X( IX ).GT.X( IXNEXT ) ) THEN - GO TO 20 - ELSE - TEMP = X( IX ) - X( IX ) = X( IXNEXT ) - X( IXNEXT ) = TEMP - END IF - IX = IXNEXT - GO TO 10 - 20 CONTINUE -* - ELSE IF( LSAME( JOB, 'D' ) ) THEN -* -* Sort in decreasing order -* - DO 40 I = 2, N - IX = 1 + ( I-1 )*INC - 30 CONTINUE - IF( IX.EQ.1 ) - $ GO TO 40 - IXNEXT = IX - INC - IF( X( IX ).LT.X( IXNEXT ) ) THEN - GO TO 40 - ELSE - TEMP = X( IX ) - X( IX ) = X( IXNEXT ) - X( IXNEXT ) = TEMP - END IF - IX = IXNEXT - GO TO 30 - 40 CONTINUE - END IF - RETURN -* -* End of SLAORD -* - END diff --git a/testing/lin/slaqge.f b/testing/lin/slaqge.f deleted file mode 100644 index 3e9b4774a480aaeb450b05eb455de4858b038b0b..0000000000000000000000000000000000000000 --- a/testing/lin/slaqge.f +++ /dev/null @@ -1,191 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED - INTEGER LDA, M, N - REAL AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - REAL A( LDA, * ), C( * ), R( * ) -* .. -* -* Purpose -* ======= -* -* SLAQGE equilibrates a general M by N matrix A using the row and -* column scaling factors in the vectors R and C. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the M by N matrix A. -* On exit, the equilibrated matrix. See EQUED for the form of -* the equilibrated matrix. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(M,1). -* -* R (input) REAL array, dimension (M) -* The row scale factors for A. -* -* C (input) REAL array, dimension (N) -* The column scale factors for A. -* -* ROWCND (input) REAL -* Ratio of the smallest R(i) to the largest R(i). -* -* COLCND (input) REAL -* Ratio of the smallest C(i) to the largest C(i). -* -* AMAX (input) REAL -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration -* = 'R': Row equilibration, i.e., A has been premultiplied by -* diag(R). -* = 'C': Column equilibration, i.e., A has been postmultiplied -* by diag(C). -* = 'B': Both row and column equilibration, i.e., A has been -* replaced by diag(R) * A * diag(C). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if row or column scaling -* should be done based on the ratio of the row or column scaling -* factors. If ROWCND < THRESH, row scaling is done, and if -* COLCND < THRESH, column scaling is done. -* -* LARGE and SMALL are threshold values used to decide if row scaling -* should be done based on the absolute size of the largest matrix -* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, THRESH - PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL CJ, LARGE, SMALL -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( M.LE.0 .OR. N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) - $ THEN -* -* No row scaling -* - IF( COLCND.GE.THRESH ) THEN -* -* No column scaling -* - EQUED = 'N' - ELSE -* -* Column scaling -* - DO 20 J = 1, N - CJ = C( J ) - DO 10 I = 1, M - A( I, J ) = CJ*A( I, J ) - 10 CONTINUE - 20 CONTINUE - EQUED = 'C' - END IF - ELSE IF( COLCND.GE.THRESH ) THEN -* -* Row scaling, no column scaling -* - DO 40 J = 1, N - DO 30 I = 1, M - A( I, J ) = R( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - EQUED = 'R' - ELSE -* -* Row and column scaling -* - DO 60 J = 1, N - CJ = C( J ) - DO 50 I = 1, M - A( I, J ) = CJ*R( I )*A( I, J ) - 50 CONTINUE - 60 CONTINUE - EQUED = 'B' - END IF -* - RETURN -* -* End of SLAQGE -* - END diff --git a/testing/lin/slaqsy.f b/testing/lin/slaqsy.f deleted file mode 100644 index bfb7502ef88728b9d2365a040228d480b967d4e9..0000000000000000000000000000000000000000 --- a/testing/lin/slaqsy.f +++ /dev/null @@ -1,178 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - REAL AMAX, SCOND -* .. -* .. Array Arguments .. - REAL A( LDA, * ), S( * ) -* .. -* -* Purpose -* ======= -* -* SLAQSY equilibrates a symmetric matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the symmetric 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) REAL array, dimension (N) -* The scale factors for A. -* -* SCOND (input) REAL -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) REAL -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, THRESH - PARAMETER ( ONE = 1.0E+0, THRESH = 0.1E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH - EXTERNAL LSAME, SLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - DO 30 I = J, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of SLAQSY -* - END diff --git a/testing/lin/slaran.f b/testing/lin/slaran.f deleted file mode 100644 index eb82d338adbd1e78a69403562f041d7f77967abe..0000000000000000000000000000000000000000 --- a/testing/lin/slaran.f +++ /dev/null @@ -1,144 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SLARAN( ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* SLARAN returns a random real number from a uniform (0,1) -* distribution. -* -* Arguments -* ========= -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine uses a multiplicative congruential method with modulus -* 2**48 and multiplier 33952834046453 (see G.S.Fishman, -* 'Multiplicative congruential random number generators with modulus -* 2**b: an exhaustive analysis for b = 32 and a partial analysis for -* b = 48', Math. Comp. 189, pp 331-344, 1990). -* -* 48-bit integers are stored in 4 integer array elements with 12 bits -* per element. Hence the routine is portable across machines with -* integers of 32 bits or more. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER M1, M2, M3, M4 - PARAMETER ( M1 = 494, M2 = 322, M3 = 2508, M4 = 2549 ) - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - INTEGER IPW2 - REAL R - PARAMETER ( IPW2 = 4096, R = ONE / IPW2 ) -* .. -* .. Local Scalars .. - INTEGER IT1, IT2, IT3, IT4 - REAL RNDOUT -* .. -* .. Intrinsic Functions .. - INTRINSIC MOD, REAL -* .. -* .. Executable Statements .. - 10 CONTINUE -* -* multiply the seed by the multiplier modulo 2**48 -* - IT4 = ISEED( 4 )*M4 - IT3 = IT4 / IPW2 - IT4 = IT4 - IPW2*IT3 - IT3 = IT3 + ISEED( 3 )*M4 + ISEED( 4 )*M3 - IT2 = IT3 / IPW2 - IT3 = IT3 - IPW2*IT2 - IT2 = IT2 + ISEED( 2 )*M4 + ISEED( 3 )*M3 + ISEED( 4 )*M2 - IT1 = IT2 / IPW2 - IT2 = IT2 - IPW2*IT1 - IT1 = IT1 + ISEED( 1 )*M4 + ISEED( 2 )*M3 + ISEED( 3 )*M2 + - $ ISEED( 4 )*M1 - IT1 = MOD( IT1, IPW2 ) -* -* return updated seed -* - ISEED( 1 ) = IT1 - ISEED( 2 ) = IT2 - ISEED( 3 ) = IT3 - ISEED( 4 ) = IT4 -* -* convert 48-bit integer to a real number in the interval (0,1) -* - RNDOUT = R*( REAL( IT1 )+R*( REAL( IT2 )+R*( REAL( IT3 )+R* - $ ( REAL( IT4 ) ) ) ) ) -* - IF (RNDOUT.EQ.1.0) THEN -* If a real number has n bits of precision, and the first -* n bits of the 48-bit integer above happen to be all 1 (which -* will occur about once every 2**n calls), then SLARAN will -* be rounded to exactly 1.0. In IEEE single precision arithmetic, -* this will happen relatively often since n = 24. -* Since SLARAN is not supposed to return exactly 0.0 or 1.0 -* (and some callers of SLARAN, such as CLARND, depend on that), -* the statistically correct thing to do in this situation is -* simply to iterate again. -* N.B. the case SLARAN = 0.0 should not be possible. -* - GOTO 10 - END IF -* - SLARAN = RNDOUT - RETURN -* -* End of SLARAN -* - END diff --git a/testing/lin/slarhs.f b/testing/lin/slarhs.f deleted file mode 100644 index 6c05afb85fadab7ff331dff34d95197c418009ba..0000000000000000000000000000000000000000 --- a/testing/lin/slarhs.f +++ /dev/null @@ -1,357 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, - $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SLARHS chooses a set of NRHS random solution vectors and sets -* up the right hand sides for the linear system -* op( A ) * X = B, -* where op( A ) may be A or A' (transpose of A). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The type of the real matrix A. PATH may be given in any -* combination of upper and lower case. Valid types include -* xGE: General m x n matrix -* xGB: General banded matrix -* xPO: Symmetric positive definite, 2-D storage -* xPP: Symmetric positive definite packed -* xPB: Symmetric positive definite banded -* xSY: Symmetric indefinite, 2-D storage -* xSP: Symmetric indefinite packed -* xSB: Symmetric indefinite banded -* xTR: Triangular -* xTP: Triangular packed -* xTB: Triangular banded -* xQR: General m x n matrix -* xLQ: General m x n matrix -* xQL: General m x n matrix -* xRQ: General m x n matrix -* where the leading character indicates the precision. -* -* XTYPE (input) CHARACTER*1 -* Specifies how the exact solution X will be determined: -* = 'N': New solution; generate a random X. -* = 'C': Computed; use value of X on entry. -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* matrix A is stored, if A is symmetric. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to the matrix A. -* = 'N': System is A * x = b -* = 'T': System is A'* x = b -* = 'C': System is A'* x = b -* -* M (input) INTEGER -* The number or rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* Used only if A is a band matrix; specifies the number of -* subdiagonals of A if A is a general band matrix or if A is -* symmetric or triangular and UPLO = 'L'; specifies the number -* of superdiagonals of A if A is symmetric or triangular and -* UPLO = 'U'. 0 <= KL <= M-1. -* -* KU (input) INTEGER -* Used only if A is a general band matrix or if A is -* triangular. -* -* If PATH = xGB, specifies the number of superdiagonals of A, -* and 0 <= KU <= N-1. -* -* If PATH = xTR, xTP, or xTB, specifies whether or not the -* matrix has unit diagonal: -* = 1: matrix has non-unit diagonal (default) -* = 2: matrix has unit diagonal -* -* NRHS (input) INTEGER -* The number of right hand side vectors in the system A*X = B. -* -* A (input) REAL array, dimension (LDA,N) -* The test matrix whose type is given by PATH. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* If PATH = xGB, LDA >= KL+KU+1. -* If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. -* Otherwise, LDA >= max(1,M). -* -* X (input or output) REAL array, dimension(LDX,NRHS) -* On entry, if XTYPE = 'C' (for 'Computed'), then X contains -* the exact solution to the system of linear equations. -* On exit, if XTYPE = 'N' (for 'New'), then X is initialized -* with random values. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). -* -* B (output) REAL array, dimension (LDB,NRHS) -* The right hand side vector(s) for the system of equations, -* computed from B = op(A) * X, where op(A) is determined by -* TRANS. -* -* LDB (input) INTEGER -* The leading dimension of the array B. If TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). -* -* ISEED (input/output) INTEGER array, dimension (4) -* The seed vector for the random number generator (used in -* SLATMS). Modified on exit. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI - CHARACTER C1, DIAG - CHARACTER*2 C2 - INTEGER J, MB, NX -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL SGBMV, SGEMM, SLACPY, SLARNV, SSBMV, SSPMV, - $ SSYMM, STBMV, STPMV, STRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) - NOTRAN = .NOT.TRAN - GEN = LSAME( PATH( 2: 2 ), 'G' ) - QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) - SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. LSAME( PATH( 2: 2 ), 'S' ) - TRI = LSAME( PATH( 2: 2 ), 'T' ) - BAND = LSAME( PATH( 3: 3 ), 'B' ) - IF( .NOT.LSAME( C1, 'Single precision' ) ) THEN - INFO = -1 - ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) - $ THEN - INFO = -2 - ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. - $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN - INFO = -3 - ELSE IF( ( GEN .OR. QRS ) .AND. .NOT. - $ ( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN - INFO = -4 - ELSE IF( M.LT.0 ) THEN - INFO = -5 - ELSE IF( N.LT.0 ) THEN - INFO = -6 - ELSE IF( BAND .AND. KL.LT.0 ) THEN - INFO = -7 - ELSE IF( BAND .AND. KU.LT.0 ) THEN - INFO = -8 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -9 - ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. - $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. - $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN - INFO = -11 - ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. - $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN - INFO = -13 - ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. - $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN - INFO = -15 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLARHS', -INFO ) - RETURN - END IF -* -* Initialize X to NRHS random vectors unless XTYPE = 'C'. -* - IF( TRAN ) THEN - NX = M - MB = N - ELSE - NX = N - MB = M - END IF - IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN - DO 10 J = 1, NRHS - CALL SLARNV( 2, ISEED, N, X( 1, J ) ) - 10 CONTINUE - END IF -* -* Multiply X by op( A ) using an appropriate -* matrix multiply routine. -* - IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. - $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. - $ LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* General matrix -* - CALL SGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, - $ ZERO, B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'SY' ) ) THEN -* -* Symmetric matrix, 2-D storage -* - CALL SSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* General matrix, band storage -* - DO 20 J = 1, NRHS - CALL SGBMV( TRANS, MB, NX, KL, KU, ONE, A, LDA, X( 1, J ), - $ 1, ZERO, B( 1, J ), 1 ) - 20 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* Symmetric matrix, band storage -* - DO 30 J = 1, NRHS - CALL SSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 30 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* Symmetric matrix, packed storage -* - DO 40 J = 1, NRHS - CALL SSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 40 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN -* -* Triangular matrix. Note that for triangular matrices, -* KU = 1 => non-unit triangular -* KU = 2 => unit triangular -* - CALL SLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - CALL STRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, - $ LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN -* -* Triangular matrix, packed storage -* - CALL SLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 50 J = 1, NRHS - CALL STPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) - 50 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* Triangular matrix, banded storage -* - CALL SLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 60 J = 1, NRHS - CALL STBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) - 60 CONTINUE -* - ELSE -* -* If PATH is none of the above, return with an error code. -* - INFO = -1 - CALL XERBLA( 'SLARHS', -INFO ) - END IF -* - RETURN -* -* End of SLARHS -* - END diff --git a/testing/lin/slarnd.f b/testing/lin/slarnd.f deleted file mode 100644 index 87680bb229cbcdb3bee870477ac238d43248022a..0000000000000000000000000000000000000000 --- a/testing/lin/slarnd.f +++ /dev/null @@ -1,124 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SLARND( IDIST, ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* SLARND returns a random real number from a uniform or normal -* distribution. -* -* Arguments -* ========= -* -* IDIST (input) INTEGER -* Specifies the distribution of the random numbers: -* = 1: uniform (0,1) -* = 2: uniform (-1,1) -* = 3: normal (0,1) -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine calls the auxiliary routine SLARAN to generate a random -* real number from a uniform (0,1) distribution. The Box-Muller method -* is used to transform numbers from a uniform to a normal distribution. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, TWO - PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 ) - REAL TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) -* .. -* .. Local Scalars .. - REAL T1, T2 -* .. -* .. External Functions .. - REAL SLARAN - EXTERNAL SLARAN -* .. -* .. Intrinsic Functions .. - INTRINSIC COS, LOG, SQRT -* .. -* .. Executable Statements .. -* -* Generate a real random number from a uniform (0,1) distribution -* - T1 = SLARAN( ISEED ) -* - IF( IDIST.EQ.1 ) THEN -* -* uniform (0,1) -* - SLARND = T1 - ELSE IF( IDIST.EQ.2 ) THEN -* -* uniform (-1,1) -* - SLARND = TWO*T1 - ONE - ELSE IF( IDIST.EQ.3 ) THEN -* -* normal (0,1) -* - T2 = SLARAN( ISEED ) - SLARND = SQRT( -TWO*LOG( T1 ) )*COS( TWOPI*T2 ) - END IF - RETURN -* -* End of SLARND -* - END diff --git a/testing/lin/slaror.f b/testing/lin/slaror.f deleted file mode 100644 index 46c2b71796f4bac1bb233095012ab852023a8e1f..0000000000000000000000000000000000000000 --- a/testing/lin/slaror.f +++ /dev/null @@ -1,275 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER INIT, SIDE - INTEGER INFO, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* SLAROR pre- or post-multiplies an M by N matrix A by a random -* orthogonal matrix U, overwriting A. A may optionally be initialized -* to the identity matrix before multiplying by U. U is generated using -* the method of G.W. Stewart (SIAM J. Numer. Anal. 17, 1980, 403-409). -* -* Arguments -* ========= -* -* SIDE (input) CHARACTER*1 -* Specifies whether A is multiplied on the left or right by U. -* = 'L': Multiply A on the left (premultiply) by U -* = 'R': Multiply A on the right (postmultiply) by U' -* = 'C' or 'T': Multiply A on the left by U and the right -* by U' (Here, U' means U-transpose.) -* -* INIT (input) CHARACTER*1 -* Specifies whether or not A should be initialized to the -* identity matrix. -* = 'I': Initialize A to (a section of) the identity matrix -* before applying U. -* = 'N': No initialization. Apply U to the input matrix A. -* -* INIT = 'I' may be used to generate square or rectangular -* orthogonal matrices: -* -* For M = N and SIDE = 'L' or 'R', the rows will be orthogonal -* to each other, as will the columns. -* -* If M < N, SIDE = 'R' produces a dense matrix whose rows are -* orthogonal and whose columns are not, while SIDE = 'L' -* produces a matrix whose rows are orthogonal, and whose first -* M columns are orthogonal, and whose remaining columns are -* zero. -* -* If M > N, SIDE = 'L' produces a dense matrix whose columns -* are orthogonal and whose rows are not, while SIDE = 'R' -* produces a matrix whose columns are orthogonal, and whose -* first M rows are orthogonal, and whose remaining rows are -* zero. -* -* M (input) INTEGER -* The number of rows of A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (input/output) REAL array, dimension (LDA, N) -* On entry, the array A. -* On exit, overwritten by U A ( if SIDE = 'L' ), -* or by A U ( if SIDE = 'R' ), -* or by U A U' ( if SIDE = 'C' or 'T'). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry ISEED specifies the seed of the random number -* generator. The array elements should be between 0 and 4095; -* if not they will be reduced mod 4096. Also, ISEED(4) must -* be odd. The random number generator uses a linear -* congruential sequence limited to small integers, and so -* should produce machine independent random numbers. The -* values of ISEED are changed on exit, and can be used in the -* next call to SLAROR to continue the same random number -* sequence. -* -* X (workspace) REAL array, dimension (3*MAX( M, N )) -* Workspace of length -* 2*M + N if SIDE = 'L', -* 2*N + M if SIDE = 'R', -* 3*N if SIDE = 'C' or 'T'. -* -* INFO (output) INTEGER -* An error flag. It is set to: -* = 0: normal return -* < 0: if INFO = -k, the k-th argument had an illegal value -* = 1: if the random numbers generated by SLARND are bad. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, TOOSML - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, - $ TOOSML = 1.0E-20 ) -* .. -* .. Local Scalars .. - INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM - REAL FACTOR, XNORM, XNORMS -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLARND, SNRM2 - EXTERNAL LSAME, SLARND, SNRM2 -* .. -* .. External Subroutines .. - EXTERNAL SGEMV, SGER, SLASET, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, SIGN -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* - ITYPE = 0 - IF( LSAME( SIDE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( SIDE, 'R' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( SIDE, 'C' ) .OR. LSAME( SIDE, 'T' ) ) THEN - ITYPE = 3 - END IF -* -* Check for argument errors. -* - INFO = 0 - IF( ITYPE.EQ.0 ) THEN - INFO = -1 - ELSE IF( M.LT.0 ) THEN - INFO = -3 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN - INFO = -4 - ELSE IF( LDA.LT.M ) THEN - INFO = -6 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLAROR', -INFO ) - RETURN - END IF -* - IF( ITYPE.EQ.1 ) THEN - NXFRM = M - ELSE - NXFRM = N - END IF -* -* Initialize A to the identity matrix if desired -* - IF( LSAME( INIT, 'I' ) ) - $ CALL SLASET( 'Full', M, N, ZERO, ONE, A, LDA ) -* -* If no rotation possible, multiply by random +/-1 -* -* Compute rotation by computing Householder transformations -* H(2), H(3), ..., H(nhouse) -* - DO 10 J = 1, NXFRM - X( J ) = ZERO - 10 CONTINUE -* - DO 30 IXFRM = 2, NXFRM - KBEG = NXFRM - IXFRM + 1 -* -* Generate independent normal( 0, 1 ) random numbers -* - DO 20 J = KBEG, NXFRM - X( J ) = SLARND( 3, ISEED ) - 20 CONTINUE -* -* Generate a Householder transformation from the random vector X -* - XNORM = SNRM2( IXFRM, X( KBEG ), 1 ) - XNORMS = SIGN( XNORM, X( KBEG ) ) - X( KBEG+NXFRM ) = SIGN( ONE, -X( KBEG ) ) - FACTOR = XNORMS*( XNORMS+X( KBEG ) ) - IF( ABS( FACTOR ).LT.TOOSML ) THEN - INFO = 1 - CALL XERBLA( 'SLAROR', INFO ) - RETURN - ELSE - FACTOR = ONE / FACTOR - END IF - X( KBEG ) = X( KBEG ) + XNORMS -* -* Apply Householder transformation to A -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN -* -* Apply H(k) from the left. -* - CALL SGEMV( 'T', IXFRM, N, ONE, A( KBEG, 1 ), LDA, - $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 ) - CALL SGER( IXFRM, N, -FACTOR, X( KBEG ), 1, X( 2*NXFRM+1 ), - $ 1, A( KBEG, 1 ), LDA ) -* - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN -* -* Apply H(k) from the right. -* - CALL SGEMV( 'N', M, IXFRM, ONE, A( 1, KBEG ), LDA, - $ X( KBEG ), 1, ZERO, X( 2*NXFRM+1 ), 1 ) - CALL SGER( M, IXFRM, -FACTOR, X( 2*NXFRM+1 ), 1, X( KBEG ), - $ 1, A( 1, KBEG ), LDA ) -* - END IF - 30 CONTINUE -* - X( 2*NXFRM ) = SIGN( ONE, SLARND( 3, ISEED ) ) -* -* Scale the matrix A by D. -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 ) THEN - DO 40 IROW = 1, M - CALL SSCAL( N, X( NXFRM+IROW ), A( IROW, 1 ), LDA ) - 40 CONTINUE - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN - DO 50 JCOL = 1, N - CALL SSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 ) - 50 CONTINUE - END IF - RETURN -* -* End of SLAROR -* - END diff --git a/testing/lin/slarot.f b/testing/lin/slarot.f deleted file mode 100644 index 40444b8e8e5a19c4ddac80ca4ac78342e0524ba8..0000000000000000000000000000000000000000 --- a/testing/lin/slarot.f +++ /dev/null @@ -1,312 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, - $ XRIGHT ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL LLEFT, LRIGHT, LROWS - INTEGER LDA, NL - REAL C, S, XLEFT, XRIGHT -* .. -* .. Array Arguments .. - REAL A( * ) -* .. -* -* Purpose -* ======= -* -* SLAROT applies a (Givens) rotation to two adjacent rows or -* columns, where one element of the first and/or last column/row -* for use on matrices stored in some format other than GE, so -* that elements of the matrix may be used or modified for which -* no array element is provided. -* -* One example is a symmetric matrix in SB format (bandwidth=4), for -* which UPLO='L': Two adjacent rows will have the format: -* -* row j: * * * * * . . . . -* row j+1: * * * * * . . . . -* -* '*' indicates elements for which storage is provided, -* '.' indicates elements for which no storage is provided, but -* are not necessarily zero; their values are determined by -* symmetry. ' ' indicates elements which are necessarily zero, -* and have no storage provided. -* -* Those columns which have two '*'s can be handled by SROT. -* Those columns which have no '*'s can be ignored, since as long -* as the Givens rotations are carefully applied to preserve -* symmetry, their values are determined. -* Those columns which have one '*' have to be handled separately, -* by using separate variables "p" and "q": -* -* row j: * * * * * p . . . -* row j+1: q * * * * * . . . . -* -* The element p would have to be set correctly, then that column -* is rotated, setting p to its new value. The next call to -* SLAROT would rotate columns j and j+1, using p, and restore -* symmetry. The element q would start out being zero, and be -* made non-zero by the rotation. Later, rotations would presumably -* be chosen to zero q out. -* -* Typical Calling Sequences: rotating the i-th and (i+1)-st rows. -* ------- ------- --------- -* -* General dense matrix: -* -* CALL SLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, -* A(i,1),LDA, DUMMY, DUMMY) -* -* General banded matrix in GB format: -* -* j = MAX(1, i-KL ) -* NL = MIN( N, i+KU+1 ) + 1-j -* CALL SLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, -* A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,KL+1) ] -* -* Symmetric banded matrix in SY format, bandwidth K, -* lower triangle only: -* -* j = MAX(1, i-K ) -* NL = MIN( K+1, i ) + 1 -* CALL SLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, -* A(i,j), LDA, XLEFT, XRIGHT ) -* -* Same, but upper triangle only: -* -* NL = MIN( K+1, N-i ) + 1 -* CALL SLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, -* A(i,i), LDA, XLEFT, XRIGHT ) -* -* Symmetric banded matrix in SB format, bandwidth K, -* lower triangle only: -* -* [ same as for SY, except:] -* . . . . -* A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,K+1) ] -* -* Same, but upper triangle only: -* . . . -* A(K+1,i), LDA-1, XLEFT, XRIGHT ) -* -* Rotating columns is just the transpose of rotating rows, except -* for GB and SB: (rotating columns i and i+1) -* -* GB: -* j = MAX(1, i-KU ) -* NL = MIN( N, i+KL+1 ) + 1-j -* CALL SLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, -* A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* [note that KU+j+1-i is just MAX(1,KU+2-i)] -* -* SB: (upper triangle) -* -* . . . . . . -* A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* SB: (lower triangle) -* -* . . . . . . -* A(1,i),LDA-1, XTOP, XBOTTM ) -* -* Arguments -* ========= -* -* LROWS - LOGICAL -* If .TRUE., then SLAROT will rotate two rows. If .FALSE., -* then it will rotate two columns. -* Not modified. -* -* LLEFT - LOGICAL -* If .TRUE., then XLEFT will be used instead of the -* corresponding element of A for the first element in the -* second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) -* If .FALSE., then the corresponding element of A will be -* used. -* Not modified. -* -* LRIGHT - LOGICAL -* If .TRUE., then XRIGHT will be used instead of the -* corresponding element of A for the last element in the -* first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If -* .FALSE., then the corresponding element of A will be used. -* Not modified. -* -* NL - INTEGER -* The length of the rows (if LROWS=.TRUE.) or columns (if -* LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are -* used, the columns/rows they are in should be included in -* NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at -* least 2. The number of rows/columns to be rotated -* exclusive of those involving XLEFT and/or XRIGHT may -* not be negative, i.e., NL minus how many of LLEFT and -* LRIGHT are .TRUE. must be at least zero; if not, XERBLA -* will be called. -* Not modified. -* -* C, S - REAL -* Specify the Givens rotation to be applied. If LROWS is -* true, then the matrix ( c s ) -* (-s c ) is applied from the left; -* if false, then the transpose thereof is applied from the -* right. For a Givens rotation, C**2 + S**2 should be 1, -* but this is not checked. -* Not modified. -* -* A - REAL array. -* The array containing the rows/columns to be rotated. The -* first element of A should be the upper left element to -* be rotated. -* Read and modified. -* -* LDA - INTEGER -* The "effective" leading dimension of A. If A contains -* a matrix stored in GE or SY format, then this is just -* the leading dimension of A as dimensioned in the calling -* routine. If A contains a matrix stored in band (GB or SB) -* format, then this should be *one less* than the leading -* dimension used in the calling routine. Thus, if -* A were dimensioned A(LDA,*) in SLAROT, then A(1,j) would -* be the j-th element in the first of the two rows -* to be rotated, and A(2,j) would be the j-th in the second, -* regardless of how the array may be stored in the calling -* routine. [A cannot, however, actually be dimensioned thus, -* since for band format, the row number may exceed LDA, which -* is not legal FORTRAN.] -* If LROWS=.TRUE., then LDA must be at least 1, otherwise -* it must be at least NL minus the number of .TRUE. values -* in XLEFT and XRIGHT. -* Not modified. -* -* XLEFT - REAL -* If LLEFT is .TRUE., then XLEFT will be used and modified -* instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) -* (if LROWS=.FALSE.). -* Read and modified. -* -* XRIGHT - REAL -* If LRIGHT is .TRUE., then XRIGHT will be used and modified -* instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) -* (if LROWS=.FALSE.). -* Read and modified. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER IINC, INEXT, IX, IY, IYT, NT -* .. -* .. Local Arrays .. - REAL XT( 2 ), YT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL SROT, XERBLA -* .. -* .. Executable Statements .. -* -* Set up indices, arrays for ends -* - IF( LROWS ) THEN - IINC = LDA - INEXT = 1 - ELSE - IINC = 1 - INEXT = LDA - END IF -* - IF( LLEFT ) THEN - NT = 1 - IX = 1 + IINC - IY = 2 + LDA - XT( 1 ) = A( 1 ) - YT( 1 ) = XLEFT - ELSE - NT = 0 - IX = 1 - IY = 1 + INEXT - END IF -* - IF( LRIGHT ) THEN - IYT = 1 + INEXT + ( NL-1 )*IINC - NT = NT + 1 - XT( NT ) = XRIGHT - YT( NT ) = A( IYT ) - END IF -* -* Check for errors -* - IF( NL.LT.NT ) THEN - CALL XERBLA( 'SLAROT', 4 ) - RETURN - END IF - IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN - CALL XERBLA( 'SLAROT', 8 ) - RETURN - END IF -* -* Rotate -* - CALL SROT( NL-NT, A( IX ), IINC, A( IY ), IINC, C, S ) - CALL SROT( NT, XT, 1, YT, 1, C, S ) -* -* Stuff values back into XLEFT, XRIGHT, etc. -* - IF( LLEFT ) THEN - A( 1 ) = XT( 1 ) - XLEFT = YT( 1 ) - END IF -* - IF( LRIGHT ) THEN - XRIGHT = XT( NT ) - A( IYT ) = YT( NT ) - END IF -* - RETURN -* -* End of SLAROT -* - END diff --git a/testing/lin/slartg.f b/testing/lin/slartg.f deleted file mode 100644 index 281b64fbf801e7efe3d5ee5eafa86d6438e2eeab..0000000000000000000000000000000000000000 --- a/testing/lin/slartg.f +++ /dev/null @@ -1,182 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - REAL CS, F, G, R, SN -* .. -* -* Purpose -* ======= -* -* SLARTG generate a plane rotation so that -* -* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. -* [ -SN CS ] [ G ] [ 0 ] -* -* This is a slower, more accurate version of the BLAS1 routine SROTG, -* with the following other differences: -* F and G are unchanged on return. -* If G=0, then CS=1 and SN=0. -* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any -* floating point operations (saves work in SBDSQR when -* there are zeros on the diagonal). -* -* If F exceeds G in magnitude, CS will be positive. -* -* Arguments -* ========= -* -* F (input) REAL -* The first component of vector to be rotated. -* -* G (input) REAL -* The second component of vector to be rotated. -* -* CS (output) REAL -* The cosine of the rotation. -* -* SN (output) REAL -* The sine of the rotation. -* -* R (output) REAL -* The nonzero component of the rotated vector. -* -* This version has a few statements commented out for thread safety -* (machine parameters are computed on each entry). 10 feb 03, SJH. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) - REAL ONE - PARAMETER ( ONE = 1.0E0 ) - REAL TWO - PARAMETER ( TWO = 2.0E0 ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, INT, LOG, MAX, SQRT -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = SLAMCH( 'S' ) - EPS = SLAMCH( 'E' ) - SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( SLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - IF( G.EQ.ZERO ) THEN - CS = ONE - SN = ZERO - R = F - ELSE IF( F.EQ.ZERO ) THEN - CS = ZERO - SN = ONE - R = G - ELSE - F1 = F - G1 = G - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) THEN - COUNT = 0 - 10 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMN2 - G1 = G1*SAFMN2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.GE.SAFMX2 ) - $ GO TO 10 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 20 I = 1, COUNT - R = R*SAFMX2 - 20 CONTINUE - ELSE IF( SCALE.LE.SAFMN2 ) THEN - COUNT = 0 - 30 CONTINUE - COUNT = COUNT + 1 - F1 = F1*SAFMX2 - G1 = G1*SAFMX2 - SCALE = MAX( ABS( F1 ), ABS( G1 ) ) - IF( SCALE.LE.SAFMN2 ) - $ GO TO 30 - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - DO 40 I = 1, COUNT - R = R*SAFMN2 - 40 CONTINUE - ELSE - R = SQRT( F1**2+G1**2 ) - CS = F1 / R - SN = G1 / R - END IF - IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN - CS = -CS - SN = -SN - R = -R - END IF - END IF - RETURN -* -* End of SLARTG -* - END diff --git a/testing/lin/slascl.f b/testing/lin/slascl.f deleted file mode 100644 index 438c0992014dc571b450de7f423f95500bd0cc15..0000000000000000000000000000000000000000 --- a/testing/lin/slascl.f +++ /dev/null @@ -1,320 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TYPE - INTEGER INFO, KL, KU, LDA, M, N - REAL CFROM, CTO -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SLASCL multiplies the M by N real matrix A by the real scalar -* CTO/CFROM. This is done without over/underflow as long as the final -* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that -* A may be full, upper triangular, lower triangular, upper Hessenberg, -* or banded. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*1 -* TYPE indices the storage type of the input matrix. -* = 'G': A is a full matrix. -* = 'L': A is a lower triangular matrix. -* = 'U': A is an upper triangular matrix. -* = 'H': A is an upper Hessenberg matrix. -* = 'B': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the lower -* half stored. -* = 'Q': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the upper -* half stored. -* = 'Z': A is a band matrix with lower bandwidth KL and upper -* bandwidth KU. -* -* KL (input) INTEGER -* The lower bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* KU (input) INTEGER -* The upper bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* CFROM (input) REAL -* CTO (input) REAL -* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed -* without over/underflow if the final result CTO*A(I,J)/CFROM -* can be represented without over/underflow. CFROM must be -* nonzero. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* The matrix to be multiplied by CTO/CFROM. See TYPE for the -* storage type. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* INFO (output) INTEGER -* 0 - successful exit -* <0 - if INFO = -i, the i-th argument had an illegal value. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - INTEGER I, ITYPE, J, K1, K2, K3, K4 - REAL BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME, SISNAN - REAL SLAMCH - EXTERNAL LSAME, SLAMCH, SISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 -* - IF( LSAME( TYPE, 'G' ) ) THEN - ITYPE = 0 - ELSE IF( LSAME( TYPE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( TYPE, 'U' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( TYPE, 'H' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( TYPE, 'B' ) ) THEN - ITYPE = 4 - ELSE IF( LSAME( TYPE, 'Q' ) ) THEN - ITYPE = 5 - ELSE IF( LSAME( TYPE, 'Z' ) ) THEN - ITYPE = 6 - ELSE - ITYPE = -1 - END IF -* - IF( ITYPE.EQ.-1 ) THEN - INFO = -1 - ELSE IF( CFROM.EQ.ZERO .OR. SISNAN(CFROM) ) THEN - INFO = -4 - ELSE IF( SISNAN(CTO) ) THEN - INFO = -5 - ELSE IF( M.LT.0 ) THEN - INFO = -6 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR. - $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN - INFO = -7 - ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN - INFO = -9 - ELSE IF( ITYPE.GE.4 ) THEN - IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN - INFO = -2 - ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR. - $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) ) - $ THEN - INFO = -3 - ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR. - $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR. - $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN - INFO = -9 - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLASCL', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* - CFROMC = CFROM - CTOC = CTO -* - 10 CONTINUE - CFROM1 = CFROMC*SMLNUM - IF( CFROM1.EQ.CFROMC ) THEN -! CFROMC is an inf. Multiply by a correctly signed zero for -! finite CTOC, or a NaN if CTOC is infinite. - MUL = CTOC / CFROMC - DONE = .TRUE. - CTO1 = CTOC - ELSE - CTO1 = CTOC / BIGNUM - IF( CTO1.EQ.CTOC ) THEN -! CTOC is either 0 or an inf. In both cases, CTOC itself -! serves as the correct multiplication factor. - MUL = CTOC - DONE = .TRUE. - CFROMC = ONE - ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN - MUL = SMLNUM - DONE = .FALSE. - CFROMC = CFROM1 - ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN - MUL = BIGNUM - DONE = .FALSE. - CTOC = CTO1 - ELSE - MUL = CTOC / CFROMC - DONE = .TRUE. - END IF - END IF -* - IF( ITYPE.EQ.0 ) THEN -* -* Full matrix -* - DO 30 J = 1, N - DO 20 I = 1, M - A( I, J ) = A( I, J )*MUL - 20 CONTINUE - 30 CONTINUE -* - ELSE IF( ITYPE.EQ.1 ) THEN -* -* Lower triangular matrix -* - DO 50 J = 1, N - DO 40 I = J, M - A( I, J ) = A( I, J )*MUL - 40 CONTINUE - 50 CONTINUE -* - ELSE IF( ITYPE.EQ.2 ) THEN -* -* Upper triangular matrix -* - DO 70 J = 1, N - DO 60 I = 1, MIN( J, M ) - A( I, J ) = A( I, J )*MUL - 60 CONTINUE - 70 CONTINUE -* - ELSE IF( ITYPE.EQ.3 ) THEN -* -* Upper Hessenberg matrix -* - DO 90 J = 1, N - DO 80 I = 1, MIN( J+1, M ) - A( I, J ) = A( I, J )*MUL - 80 CONTINUE - 90 CONTINUE -* - ELSE IF( ITYPE.EQ.4 ) THEN -* -* Lower half of a symmetric band matrix -* - K3 = KL + 1 - K4 = N + 1 - DO 110 J = 1, N - DO 100 I = 1, MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 100 CONTINUE - 110 CONTINUE -* - ELSE IF( ITYPE.EQ.5 ) THEN -* -* Upper half of a symmetric band matrix -* - K1 = KU + 2 - K3 = KU + 1 - DO 130 J = 1, N - DO 120 I = MAX( K1-J, 1 ), K3 - A( I, J ) = A( I, J )*MUL - 120 CONTINUE - 130 CONTINUE -* - ELSE IF( ITYPE.EQ.6 ) THEN -* -* Band matrix -* - K1 = KL + KU + 2 - K2 = KL + 1 - K3 = 2*KL + KU + 1 - K4 = KL + KU + 1 + M - DO 150 J = 1, N - DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 140 CONTINUE - 150 CONTINUE -* - END IF -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of SLASCL -* - END diff --git a/testing/lin/slaset.f b/testing/lin/slaset.f deleted file mode 100644 index 9662d566ff7063c2b318177d16ab2a82aa5224be..0000000000000000000000000000000000000000 --- a/testing/lin/slaset.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, M, N - REAL ALPHA, BETA -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SLASET initializes an m-by-n matrix A to BETA on the diagonal and -* ALPHA on the offdiagonals. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies the part of the matrix A to be set. -* = 'U': Upper triangular part is set; the strictly lower -* triangular part of A is not changed. -* = 'L': Lower triangular part is set; the strictly upper -* triangular part of A is not changed. -* Otherwise: All of the matrix A is set. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* ALPHA (input) REAL -* The constant to which the offdiagonal elements are to be set. -* -* BETA (input) REAL -* The constant to which the diagonal elements are to be set. -* -* A (input/output) REAL array, dimension (LDA,N) -* On exit, the leading m-by-n submatrix of A is set as follows: -* -* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, -* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, -* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, -* -* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, J -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC MIN -* .. -* .. Executable Statements .. -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Set the strictly upper triangular or trapezoidal part of the -* array to ALPHA. -* - DO 20 J = 2, N - DO 10 I = 1, MIN( J-1, M ) - A( I, J ) = ALPHA - 10 CONTINUE - 20 CONTINUE -* - ELSE IF( LSAME( UPLO, 'L' ) ) THEN -* -* Set the strictly lower triangular or trapezoidal part of the -* array to ALPHA. -* - DO 40 J = 1, MIN( M, N ) - DO 30 I = J + 1, M - A( I, J ) = ALPHA - 30 CONTINUE - 40 CONTINUE -* - ELSE -* -* Set the leading m-by-n submatrix to ALPHA. -* - DO 60 J = 1, N - DO 50 I = 1, M - A( I, J ) = ALPHA - 50 CONTINUE - 60 CONTINUE - END IF -* -* Set the first min(M,N) diagonal elements to BETA. -* - DO 70 I = 1, MIN( M, N ) - A( I, I ) = BETA - 70 CONTINUE -* - RETURN -* -* End of SLASET -* - END diff --git a/testing/lin/slatb4.f b/testing/lin/slatb4.f deleted file mode 100644 index d41040b00e4c2dfd57ed017fa43b458b26c9254c..0000000000000000000000000000000000000000 --- a/testing/lin/slatb4.f +++ /dev/null @@ -1,477 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER IMAT, KL, KU, M, MODE, N - REAL ANORM, CNDNUM -* .. -* -* Purpose -* ======= -* -* SLATB4 sets parameters for the matrix generator based on the type of -* matrix to be generated. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name. -* -* IMAT (input) INTEGER -* An integer key describing which matrix to generate for this -* path. -* -* M (input) INTEGER -* The number of rows in the matrix to be generated. -* -* N (input) INTEGER -* The number of columns in the matrix to be generated. -* -* TYPE (output) CHARACTER*1 -* The type of the matrix to be generated: -* = 'S': symmetric matrix -* = 'P': symmetric positive (semi)definite matrix -* = 'N': nonsymmetric matrix -* -* KL (output) INTEGER -* The lower band width of the matrix to be generated. -* -* KU (output) INTEGER -* The upper band width of the matrix to be generated. -* -* ANORM (output) REAL -* The desired norm of the matrix to be generated. The diagonal -* matrix of singular values or eigenvalues is scaled by this -* value. -* -* MODE (output) INTEGER -* A key indicating how to choose the vector of eigenvalues. -* -* CNDNUM (output) REAL -* The desired condition number. -* -* DIST (output) CHARACTER*1 -* The type of distribution to be used by the random number -* generator. -* -* ===================================================================== -* -* .. Parameters .. - REAL SHRINK, TENTH - PARAMETER ( SHRINK = 0.25E0, TENTH = 0.1E+0 ) - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - REAL TWO - PARAMETER ( TWO = 2.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL FIRST - CHARACTER*2 C2 - INTEGER MAT - REAL BADC1, BADC2, EPS, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAMEN - REAL SLAMCH - EXTERNAL LSAMEN, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT -* .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. -* .. Save statement .. - SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST -* .. -* .. Data statements .. - DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* Set some constants for use in the subroutine. -* - IF( FIRST ) THEN - FIRST = .FALSE. - EPS = SLAMCH( 'Precision' ) - BADC2 = TENTH / EPS - BADC1 = SQRT( BADC2 ) - SMALL = SLAMCH( 'Safe minimum' ) - LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) - SMALL = SHRINK*( SMALL / EPS ) - LARGE = ONE / SMALL - END IF -* - C2 = PATH( 2: 3 ) -* -* Set some parameters we don't plan to change. -* - DIST = 'S' - MODE = 3 -* - IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR. - $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* xQR, xLQ, xQL, xRQ: Set parameters to generate a general -* M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* xGE: Set parameters to generate a general M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.10 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.11 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* xGB: Set parameters to generate a general banded matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = TENTH*BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN -* -* xGT: Set parameters to generate a general tridiagonal matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) .OR. - $ LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* xPO, xPP, xSY, xSP: Set parameters to generate a -* symmetric matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = C2( 1: 1 ) -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = MAX( N-1, 0 ) - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.7 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.8 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.9 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* xPB: Set parameters to generate a symmetric band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'P' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN -* -* xPT: Set parameters to generate a symmetric positive definite -* tridiagonal matrix. -* - TYPE = 'P' - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN -* -* xTR, xTP: Set parameters to generate a triangular matrix -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - MAT = ABS( IMAT ) - IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.LT.0 ) THEN - KL = MAX( N-1, 0 ) - KU = 0 - ELSE - KL = 0 - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN - CNDNUM = BADC1 - ELSE IF( MAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE IF( MAT.EQ.10 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( MAT.EQ.5 ) THEN - ANORM = SMALL - ELSE IF( MAT.EQ.6 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* xTB: Set parameters to generate a triangular band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.2 .OR. IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.3 .OR. IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.4 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.5 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF - END IF - IF( N.LE.1 ) - $ CNDNUM = ONE -* - RETURN -* -* End of SLATB4 -* - END diff --git a/testing/lin/slatm1.f b/testing/lin/slatm1.f deleted file mode 100644 index f4773dcfb70e08fc3c097801eb193e85f8049c53..0000000000000000000000000000000000000000 --- a/testing/lin/slatm1.f +++ /dev/null @@ -1,273 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST, INFO, IRSIGN, MODE, N - REAL COND -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL D( * ) -* .. -* -* Purpose -* ======= -* -* SLATM1 computes the entries of D(1..N) as specified by -* MODE, COND and IRSIGN. IDIST and ISEED determine the generation -* of random numbers. SLATM1 is called by SLATMR to generate -* random test matrices for LAPACK programs. -* -* Arguments -* ========= -* -* MODE - INTEGER -* On entry describes how D is to be computed: -* MODE = 0 means do not change D. -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* Not modified. -* -* COND - REAL -* On entry, used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* IRSIGN - INTEGER -* On entry, if MODE neither -6, 0 nor 6, determines sign of -* entries of D -* 0 => leave entries of D unchanged -* 1 => multiply each entry of D by 1 or -1 with probability .5 -* -* IDIST - CHARACTER*1 -* On entry, IDIST specifies the type of distribution to be -* used to generate a random matrix . -* 1 => UNIFORM( 0, 1 ) -* 2 => UNIFORM( -1, 1 ) -* 3 => NORMAL( 0, 1 ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The random number generator uses a -* linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to SLATM1 -* to continue the same random number sequence. -* Changed on exit. -* -* D - REAL array, dimension ( MIN( M , N ) ) -* Array to be computed according to MODE, COND and IRSIGN. -* May be changed on exit if MODE is nonzero. -* -* N - INTEGER -* Number of entries of D. Not modified. -* -* INFO - INTEGER -* 0 => normal termination -* -1 => if MODE not in range -6 to 6 -* -2 => if MODE neither -6, 0 nor 6, and -* IRSIGN neither 0 nor 1 -* -3 => if MODE neither -6, 0 nor 6 and COND less than 1 -* -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 3 -* -7 => if N negative -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) - REAL HALF - PARAMETER ( HALF = 0.5E0 ) -* .. -* .. Local Scalars .. - INTEGER I - REAL ALPHA, TEMP -* .. -* .. External Functions .. - REAL SLARAN - EXTERNAL SLARAN -* .. -* .. External Subroutines .. - EXTERNAL SLARNV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, EXP, LOG, REAL -* .. -* .. Executable Statements .. -* -* Decode and Test the input parameters. Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Set INFO if an error -* - IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN - INFO = -1 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN - INFO = -2 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ COND.LT.ONE ) THEN - INFO = -3 - ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND. - $ ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -7 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLATM1', -INFO ) - RETURN - END IF -* -* Compute D according to COND and MODE -* - IF( MODE.NE.0 ) THEN - GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE ) -* -* One large D value: -* - 10 CONTINUE - DO 20 I = 1, N - D( I ) = ONE / COND - 20 CONTINUE - D( 1 ) = ONE - GO TO 120 -* -* One small D value: -* - 30 CONTINUE - DO 40 I = 1, N - D( I ) = ONE - 40 CONTINUE - D( N ) = ONE / COND - GO TO 120 -* -* Exponentially distributed D values: -* - 50 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - ALPHA = COND**( -ONE / REAL( N-1 ) ) - DO 60 I = 2, N - D( I ) = ALPHA**( I-1 ) - 60 CONTINUE - END IF - GO TO 120 -* -* Arithmetically distributed D values: -* - 70 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - TEMP = ONE / COND - ALPHA = ( ONE-TEMP ) / REAL( N-1 ) - DO 80 I = 2, N - D( I ) = REAL( N-I )*ALPHA + TEMP - 80 CONTINUE - END IF - GO TO 120 -* -* Randomly distributed D values on ( 1/COND , 1): -* - 90 CONTINUE - ALPHA = LOG( ONE / COND ) - DO 100 I = 1, N - D( I ) = EXP( ALPHA*SLARAN( ISEED ) ) - 100 CONTINUE - GO TO 120 -* -* Randomly distributed D values from IDIST -* - 110 CONTINUE - CALL SLARNV( IDIST, ISEED, N, D ) -* - 120 CONTINUE -* -* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign -* random signs to D -* - IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ IRSIGN.EQ.1 ) THEN - DO 130 I = 1, N - TEMP = SLARAN( ISEED ) - IF( TEMP.GT.HALF ) - $ D( I ) = -D( I ) - 130 CONTINUE - END IF -* -* Reverse if MODE < 0 -* - IF( MODE.LT.0 ) THEN - DO 140 I = 1, N / 2 - TEMP = D( I ) - D( I ) = D( N+1-I ) - D( N+1-I ) = TEMP - 140 CONTINUE - END IF -* - END IF -* - RETURN -* -* End of SLATM1 -* - END diff --git a/testing/lin/slatms.f b/testing/lin/slatms.f deleted file mode 100644 index 3cc20f03890a891bb07783536a8df1b5e748feb7..0000000000000000000000000000000000000000 --- a/testing/lin/slatms.f +++ /dev/null @@ -1,1076 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, - $ KL, KU, PACK, A, LDA, WORK, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, PACK, SYM - INTEGER INFO, KL, KU, LDA, M, MODE, N - REAL COND, DMAX -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), D( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* SLATMS generates random matrices with specified singular values -* (or symmetric/hermitian with specified eigenvalues) -* for testing LAPACK programs. -* -* SLATMS operates by applying the following sequence of -* operations: -* -* Set the diagonal to D, where D may be input or -* computed according to MODE, COND, DMAX, and SYM -* as described below. -* -* Generate a matrix with the appropriate band structure, by one -* of two methods: -* -* Method A: -* Generate a dense M x N matrix by multiplying D on the left -* and the right by random unitary matrices, then: -* -* Reduce the bandwidth according to KL and KU, using -* Householder transformations. -* -* Method B: -* Convert the bandwidth-0 (i.e., diagonal) matrix to a -* bandwidth-1 matrix using Givens rotations, "chasing" -* out-of-band elements back, much as in QR; then -* convert the bandwidth-1 to a bandwidth-2 matrix, etc. -* Note that for reasonably small bandwidths (relative to -* M and N) this requires less storage, as a dense matrix -* is not generated. Also, for symmetric matrices, only -* one triangle is generated. -* -* Method A is chosen if the bandwidth is a large fraction of the -* order of the matrix, and LDA is at least M (so a dense -* matrix can be stored.) Method B is chosen if the bandwidth -* is small (< 1/2 N for symmetric, < .3 N+M for -* non-symmetric), or LDA is less than M and not less than the -* bandwidth. -* -* Pack the matrix if desired. Options specified by PACK are: -* no packing -* zero out upper half (if symmetric) -* zero out lower half (if symmetric) -* store the upper half columnwise (if symmetric or upper -* triangular) -* store the lower half columnwise (if symmetric or lower -* triangular) -* store the lower triangle in banded format (if symmetric -* or lower triangular) -* store the upper triangle in banded format (if symmetric -* or upper triangular) -* store the entire matrix in banded format -* If Method B is chosen, and band format is specified, then the -* matrix will be generated in the band format, so no repacking -* will be necessary. -* -* Arguments -* ========= -* -* M - INTEGER -* The number of rows of A. Not modified. -* -* N - INTEGER -* The number of columns of A. Not modified. -* -* DIST - CHARACTER*1 -* On entry, DIST specifies the type of distribution to be used -* to generate the random eigen-/singular values. -* 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) -* 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) -* 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. They should lie between 0 and 4095 inclusive, -* and ISEED(4) should be odd. The random number generator -* uses a linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to SLATMS -* to continue the same random number sequence. -* Changed on exit. -* -* SYM - CHARACTER*1 -* If SYM='S' or 'H', the generated matrix is symmetric, with -* eigenvalues specified by D, COND, MODE, and DMAX; they -* may be positive, negative, or zero. -* If SYM='P', the generated matrix is symmetric, with -* eigenvalues (= singular values) specified by D, COND, -* MODE, and DMAX; they will not be negative. -* If SYM='N', the generated matrix is nonsymmetric, with -* singular values specified by D, COND, MODE, and DMAX; -* they will not be negative. -* Not modified. -* -* D - REAL array, dimension ( MIN( M , N ) ) -* This array is used to specify the singular values or -* eigenvalues of A (see SYM, above.) If MODE=0, then D is -* assumed to contain the singular/eigenvalues, otherwise -* they will be computed according to MODE, COND, and DMAX, -* and placed in D. -* Modified if MODE is nonzero. -* -* MODE - INTEGER -* On entry this describes how the singular/eigenvalues are to -* be specified: -* MODE = 0 means use D as input -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then -* the elements of D will also be multiplied by a random -* sign (i.e., +1 or -1.) -* Not modified. -* -* COND - REAL -* On entry, this is used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* DMAX - REAL -* If MODE is neither -6, 0 nor 6, the contents of D, as -* computed according to MODE and COND, will be scaled by -* DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or -* singular value (which is to say the norm) will be abs(DMAX). -* Note that DMAX need not be positive: if DMAX is negative -* (or zero), D will be scaled by a negative number (or zero). -* Not modified. -* -* KL - INTEGER -* This specifies the lower bandwidth of the matrix. For -* example, KL=0 implies upper triangular, KL=1 implies upper -* Hessenberg, and KL being at least M-1 means that the matrix -* has full lower bandwidth. KL must equal KU if the matrix -* is symmetric. -* Not modified. -* -* KU - INTEGER -* This specifies the upper bandwidth of the matrix. For -* example, KU=0 implies lower triangular, KU=1 implies lower -* Hessenberg, and KU being at least N-1 means that the matrix -* has full upper bandwidth. KL must equal KU if the matrix -* is symmetric. -* Not modified. -* -* PACK - CHARACTER*1 -* This specifies packing of matrix as follows: -* 'N' => no packing -* 'U' => zero out all subdiagonal entries (if symmetric) -* 'L' => zero out all superdiagonal entries (if symmetric) -* 'C' => store the upper triangle columnwise -* (only if the matrix is symmetric or upper triangular) -* 'R' => store the lower triangle columnwise -* (only if the matrix is symmetric or lower triangular) -* 'B' => store the lower triangle in band storage scheme -* (only if matrix symmetric or lower triangular) -* 'Q' => store the upper triangle in band storage scheme -* (only if matrix symmetric or upper triangular) -* 'Z' => store the entire matrix in band storage scheme -* (pivoting can be provided for by using this -* option to store A in the trailing rows of -* the allocated storage) -* -* Using these options, the various LAPACK packed and banded -* storage schemes can be obtained: -* GB - use 'Z' -* PB, SB or TB - use 'B' or 'Q' -* PP, SP or TP - use 'C' or 'R' -* -* If two calls to SLATMS differ only in the PACK parameter, -* they will generate mathematically equivalent matrices. -* Not modified. -* -* A - REAL array, dimension ( LDA, N ) -* On exit A is the desired test matrix. A is first generated -* in full (unpacked) form, and then packed, if so specified -* by PACK. Thus, the first M elements of the first N -* columns will always be modified. If PACK specifies a -* packed or banded storage scheme, all LDA elements of the -* first N columns will be modified; the elements of the -* array which do not correspond to elements of the generated -* matrix are set to zero. -* Modified. -* -* LDA - INTEGER -* LDA specifies the first dimension of A as declared in the -* calling program. If PACK='N', 'U', 'L', 'C', or 'R', then -* LDA must be at least M. If PACK='B' or 'Q', then LDA must -* be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). -* If PACK='Z', LDA must be large enough to hold the packed -* array: MIN( KU, N-1) + MIN( KL, M-1) + 1. -* Not modified. -* -* WORK - REAL array, dimension ( 3*MAX( N , M ) ) -* Workspace. -* Modified. -* -* INFO - INTEGER -* Error code. On exit, INFO will be set to one of the -* following values: -* 0 => normal return -* -1 => M negative or unequal to N and SYM='S', 'H', or 'P' -* -2 => N negative -* -3 => DIST illegal string -* -5 => SYM illegal string -* -7 => MODE not in range -6 to 6 -* -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 -* -10 => KL negative -* -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL -* -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; -* or PACK='C' or 'Q' and SYM='N' and KL is not zero; -* or PACK='R' or 'B' and SYM='N' and KU is not zero; -* or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not -* N. -* -14 => LDA is less than M, or PACK='Z' and LDA is less than -* MIN(KU,N-1) + MIN(KL,M-1) + 1. -* 1 => Error return from SLATM1 -* 2 => Cannot scale to DMAX (max. sing. value is 0) -* 3 => Error return from SLAGGE or SLAGSY -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) - REAL ONE - PARAMETER ( ONE = 1.0E0 ) - REAL TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) -* .. -* .. Local Scalars .. - LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN - INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA, - $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2, - $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH, - $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC, - $ UUB - REAL ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLARND - EXTERNAL LSAME, SLARND -* .. -* .. External Subroutines .. - EXTERNAL SCOPY, SLAGGE, SLAGSY, SLAROT, SLARTG, SLATM1, - $ SLASET, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, COS, MAX, MIN, MOD, REAL, SIN -* .. -* .. Executable Statements .. -* -* 1) Decode and Test the input parameters. -* Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN -* -* Decode DIST -* - IF( LSAME( DIST, 'U' ) ) THEN - IDIST = 1 - ELSE IF( LSAME( DIST, 'S' ) ) THEN - IDIST = 2 - ELSE IF( LSAME( DIST, 'N' ) ) THEN - IDIST = 3 - ELSE - IDIST = -1 - END IF -* -* Decode SYM -* - IF( LSAME( SYM, 'N' ) ) THEN - ISYM = 1 - IRSIGN = 0 - ELSE IF( LSAME( SYM, 'P' ) ) THEN - ISYM = 2 - IRSIGN = 0 - ELSE IF( LSAME( SYM, 'S' ) ) THEN - ISYM = 2 - IRSIGN = 1 - ELSE IF( LSAME( SYM, 'H' ) ) THEN - ISYM = 2 - IRSIGN = 1 - ELSE - ISYM = -1 - END IF -* -* Decode PACK -* - ISYMPK = 0 - IF( LSAME( PACK, 'N' ) ) THEN - IPACK = 0 - ELSE IF( LSAME( PACK, 'U' ) ) THEN - IPACK = 1 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'L' ) ) THEN - IPACK = 2 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'C' ) ) THEN - IPACK = 3 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'R' ) ) THEN - IPACK = 4 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'B' ) ) THEN - IPACK = 5 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'Q' ) ) THEN - IPACK = 6 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'Z' ) ) THEN - IPACK = 7 - ELSE - IPACK = -1 - END IF -* -* Set certain internal parameters -* - MNMIN = MIN( M, N ) - LLB = MIN( KL, M-1 ) - UUB = MIN( KU, N-1 ) - MR = MIN( M, N+LLB ) - NC = MIN( N, M+UUB ) -* - IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN - MINLDA = UUB + 1 - ELSE IF( IPACK.EQ.7 ) THEN - MINLDA = LLB + UUB + 1 - ELSE - MINLDA = M - END IF -* -* Use Givens rotation method if bandwidth small enough, -* or if LDA is too small to store the matrix unpacked. -* - GIVENS = .FALSE. - IF( ISYM.EQ.1 ) THEN - IF( REAL( LLB+UUB ).LT.0.3*REAL( MAX( 1, MR+NC ) ) ) - $ GIVENS = .TRUE. - ELSE - IF( 2*LLB.LT.M ) - $ GIVENS = .TRUE. - END IF - IF( LDA.LT.M .AND. LDA.GE.MINLDA ) - $ GIVENS = .TRUE. -* -* Set INFO if an error -* - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( IDIST.EQ.-1 ) THEN - INFO = -3 - ELSE IF( ISYM.EQ.-1 ) THEN - INFO = -5 - ELSE IF( ABS( MODE ).GT.6 ) THEN - INFO = -7 - ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) - $ THEN - INFO = -8 - ELSE IF( KL.LT.0 ) THEN - INFO = -10 - ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN - INFO = -11 - ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR. - $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR. - $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR. - $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN - INFO = -12 - ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN - INFO = -14 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLATMS', -INFO ) - RETURN - END IF -* -* Initialize random number generator -* - DO 10 I = 1, 4 - ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) - 10 CONTINUE -* - IF( MOD( ISEED( 4 ), 2 ).NE.1 ) - $ ISEED( 4 ) = ISEED( 4 ) + 1 -* -* 2) Set up D if indicated. -* -* Compute D according to COND and MODE -* - CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) - IF( IINFO.NE.0 ) THEN - INFO = 1 - RETURN - END IF -* -* Choose Top-Down if D is (apparently) increasing, -* Bottom-Up if D is (apparently) decreasing. -* - IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN - TOPDWN = .TRUE. - ELSE - TOPDWN = .FALSE. - END IF -* - IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN -* -* Scale by DMAX -* - TEMP = ABS( D( 1 ) ) - DO 20 I = 2, MNMIN - TEMP = MAX( TEMP, ABS( D( I ) ) ) - 20 CONTINUE -* - IF( TEMP.GT.ZERO ) THEN - ALPHA = DMAX / TEMP - ELSE - INFO = 2 - RETURN - END IF -* - CALL SSCAL( MNMIN, ALPHA, D, 1 ) -* - END IF -* -* 3) Generate Banded Matrix using Givens rotations. -* Also the special case of UUB=LLB=0 -* -* Compute Addressing constants to cover all -* storage formats. Whether GE, SY, GB, or SB, -* upper or lower triangle or both, -* the (i,j)-th element is in -* A( i - ISKEW*j + IOFFST, j ) -* - IF( IPACK.GT.4 ) THEN - ILDA = LDA - 1 - ISKEW = 1 - IF( IPACK.GT.5 ) THEN - IOFFST = UUB + 1 - ELSE - IOFFST = 1 - END IF - ELSE - ILDA = LDA - ISKEW = 0 - IOFFST = 0 - END IF -* -* IPACKG is the format that the matrix is generated in. If this is -* different from IPACK, then the matrix must be repacked at the -* end. It also signals how to compute the norm, for scaling. -* - IPACKG = 0 - CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) -* -* Diagonal Matrix -- We are done, unless it -* is to be stored SP/PP/TP (PACK='R' or 'C') -* - IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN - CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) - IF( IPACK.LE.2 .OR. IPACK.GE.5 ) - $ IPACKG = IPACK -* - ELSE IF( GIVENS ) THEN -* -* Check whether to use Givens rotations, -* Householder transformations, or nothing. -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - IF( IPACK.GT.4 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF -* - CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) -* - IF( TOPDWN ) THEN - JKL = 0 - DO 50 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* Last row actually rotated is M -* Last column actually rotated is MIN( M+JKU, N ) -* - DO 40 JR = 1, MIN( M+JKU, N ) + JKL - 1 - EXTRA = ZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - ICOL = MAX( 1, JR-JKL ) - IF( JR.LT.M ) THEN - IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, - $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IR = JR - IC = ICOL - DO 30 JCH = JR - JKL, 1, -JKL - JKU - IF( IR.LT.M ) THEN - CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, C, S, DUMMY ) - END IF - IROW = MAX( 1, JCH-JKU ) - IL = IR + 2 - IROW - TEMP = ZERO - ILTEMP = JCH.GT.JKU - CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, - $ A( IROW-ISKEW*IC+IOFFST, IC ), - $ ILDA, TEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL SLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), TEMP, C, S, DUMMY ) - ICOL = MAX( 1, JCH-JKU-JKL ) - IL = IC + 2 - ICOL - EXTRA = ZERO - CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., - $ IL, C, -S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ TEMP ) - IC = ICOL - IR = IROW - END IF - 30 CONTINUE - 40 CONTINUE - 50 CONTINUE -* - JKU = UUB - DO 80 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* - DO 70 JC = 1, MIN( N+JKL, M ) + JKU - 1 - EXTRA = ZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - IROW = MAX( 1, JC-JKU ) - IF( JC.LT.N ) THEN - IL = MIN( M, JC+JKL ) + 1 - IROW - CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, - $ S, A( IROW-ISKEW*JC+IOFFST, JC ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IC = JC - IR = IROW - DO 60 JCH = JC - JKU, 1, -JKL - JKU - IF( IC.LT.N ) THEN - CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, C, S, DUMMY ) - END IF - ICOL = MAX( 1, JCH-JKL ) - IL = IC + 2 - ICOL - TEMP = ZERO - ILTEMP = JCH.GT.JKL - CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, - $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, TEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL SLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST, - $ ICOL+1 ), TEMP, C, S, DUMMY ) - IROW = MAX( 1, JCH-JKL-JKU ) - IL = IR + 2 - IROW - EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., - $ IL, C, -S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ TEMP ) - IC = ICOL - IR = IROW - END IF - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* - ELSE -* -* Bottom-Up -- Start at the bottom right. -* - JKL = 0 - DO 110 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* First row actually rotated is M -* First column actually rotated is MIN( M+JKU, N ) -* - IENDCH = MIN( M, N+JKL ) - 1 - DO 100 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1 - EXTRA = ZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - IROW = MAX( 1, JC-JKU+1 ) - IF( JC.GT.0 ) THEN - IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, - $ C, S, A( IROW-ISKEW*JC+IOFFST, - $ JC ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IC = JC - DO 90 JCH = JC + JKL, IENDCH, JKL + JKU - ILEXTR = IC.GT.0 - IF( ILEXTR ) THEN - CALL SLARTG( A( JCH-ISKEW*IC+IOFFST, IC ), - $ EXTRA, C, S, DUMMY ) - END IF - IC = MAX( 1, IC ) - ICOL = MIN( N-1, JCH+JKU ) - ILTEMP = JCH + JKU.LT.N - TEMP = ZERO - CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, - $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), - $ ILDA, EXTRA, TEMP ) - IF( ILTEMP ) THEN - CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), TEMP, C, S, DUMMY ) - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = ZERO - CALL SLAROT( .FALSE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, TEMP, EXTRA ) - IC = ICOL - END IF - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE -* - JKU = UUB - DO 140 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* -* First row actually rotated is MIN( N+JKL, M ) -* First column actually rotated is N -* - IENDCH = MIN( N, M+JKU ) - 1 - DO 130 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1 - EXTRA = ZERO - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - ICOL = MAX( 1, JR-JKL+1 ) - IF( JR.GT.0 ) THEN - IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, - $ C, S, A( JR-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IR = JR - DO 120 JCH = JR + JKU, IENDCH, JKL + JKU - ILEXTR = IR.GT.0 - IF( ILEXTR ) THEN - CALL SLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ), - $ EXTRA, C, S, DUMMY ) - END IF - IR = MAX( 1, IR ) - IROW = MIN( M-1, JCH+JKL ) - ILTEMP = JCH + JKL.LT.M - TEMP = ZERO - CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, - $ C, S, A( IR-ISKEW*JCH+IOFFST, - $ JCH ), ILDA, EXTRA, TEMP ) - IF( ILTEMP ) THEN - CALL SLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ TEMP, C, S, DUMMY ) - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = ZERO - CALL SLAROT( .TRUE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ ILDA, TEMP, EXTRA ) - IR = IROW - END IF - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - END IF -* - ELSE -* -* Symmetric -- A = U D U' -* - IPACKG = IPACK - IOFFG = IOFFST -* - IF( TOPDWN ) THEN -* -* Top-Down -- Generate Upper triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 6 - IOFFG = UUB + 1 - ELSE - IPACKG = 1 - END IF - CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) -* - DO 170 K = 1, UUB - DO 160 JC = 1, N - 1 - IROW = MAX( 1, JC-K ) - IL = MIN( JC+1, K+2 ) - EXTRA = ZERO - TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 ) - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = SIN( ANGLE ) - CALL SLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S, - $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA, - $ EXTRA, TEMP ) - CALL SLAROT( .TRUE., .TRUE., .FALSE., - $ MIN( K, N-JC )+1, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ TEMP, DUMMY ) -* -* Chase EXTRA back up the matrix -* - ICOL = JC - DO 150 JCH = JC - K, 1, -K - CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, - $ ICOL+1 ), EXTRA, C, S, DUMMY ) - TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, - $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, TEMP, EXTRA ) - IROW = MAX( 1, JCH-K ) - IL = MIN( JCH+1, K+2 ) - EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, - $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), - $ ILDA, EXTRA, TEMP ) - ICOL = JCH - 150 CONTINUE - 160 CONTINUE - 170 CONTINUE -* -* If we need lower triangle, copy from upper. Note that -* the order of copying is chosen to work for 'q' -> 'b' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN - DO 190 JC = 1, N - IROW = IOFFST - ISKEW*JC - DO 180 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 180 CONTINUE - 190 CONTINUE - IF( IPACK.EQ.5 ) THEN - DO 210 JC = N - UUB + 1, N - DO 200 JR = N + 2 - JC, UUB + 1 - A( JR, JC ) = ZERO - 200 CONTINUE - 210 CONTINUE - END IF - IF( IPACKG.EQ.6 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - ELSE -* -* Bottom-Up -- Generate Lower triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 5 - IF( IPACK.EQ.6 ) - $ IOFFG = 1 - ELSE - IPACKG = 2 - END IF - CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) -* - DO 240 K = 1, UUB - DO 230 JC = N - 1, 1, -1 - IL = MIN( N+1-JC, K+2 ) - EXTRA = ZERO - TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC ) - ANGLE = TWOPI*SLARND( 1, ISEED ) - C = COS( ANGLE ) - S = -SIN( ANGLE ) - CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ TEMP, EXTRA ) - ICOL = MAX( 1, JC-K+1 ) - CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, - $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, DUMMY, TEMP ) -* -* Chase EXTRA back down the matrix -* - ICOL = JC - DO 220 JCH = JC + K, N - 1, K - CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ EXTRA, C, S, DUMMY ) - TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, EXTRA, TEMP ) - IL = MIN( N+1-JCH, K+2 ) - EXTRA = ZERO - CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, - $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, TEMP, EXTRA ) - ICOL = JCH - 220 CONTINUE - 230 CONTINUE - 240 CONTINUE -* -* If we need upper triangle, copy from lower. Note that -* the order of copying is chosen to work for 'b' -> 'q' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN - DO 260 JC = N, 1, -1 - IROW = IOFFST - ISKEW*JC - DO 250 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 250 CONTINUE - 260 CONTINUE - IF( IPACK.EQ.6 ) THEN - DO 280 JC = 1, UUB - DO 270 JR = 1, UUB + 1 - JC - A( JR, JC ) = ZERO - 270 CONTINUE - 280 CONTINUE - END IF - IF( IPACKG.EQ.5 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - END IF - END IF -* - ELSE -* -* 4) Generate Banded Matrix by first -* Rotating by random Unitary matrices, -* then reducing the bandwidth using Householder -* transformations. -* -* Note: we should get here only if LDA .ge. N -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - CALL SLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK, - $ IINFO ) - ELSE -* -* Symmetric -- A = U D U' -* - CALL SLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) -* - END IF - IF( IINFO.NE.0 ) THEN - INFO = 3 - RETURN - END IF - END IF -* -* 5) Pack the matrix -* - IF( IPACK.NE.IPACKG ) THEN - IF( IPACK.EQ.1 ) THEN -* -* 'U' -- Upper triangular, not packed -* - DO 300 J = 1, M - DO 290 I = J + 1, M - A( I, J ) = ZERO - 290 CONTINUE - 300 CONTINUE -* - ELSE IF( IPACK.EQ.2 ) THEN -* -* 'L' -- Lower triangular, not packed -* - DO 320 J = 2, M - DO 310 I = 1, J - 1 - A( I, J ) = ZERO - 310 CONTINUE - 320 CONTINUE -* - ELSE IF( IPACK.EQ.3 ) THEN -* -* 'C' -- Upper triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 340 J = 1, M - DO 330 I = 1, J - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 330 CONTINUE - 340 CONTINUE -* - ELSE IF( IPACK.EQ.4 ) THEN -* -* 'R' -- Lower triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 360 J = 1, M - DO 350 I = J, M - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 350 CONTINUE - 360 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* 'B' -- The lower triangle is packed as a band matrix. -* 'Q' -- The upper triangle is packed as a band matrix. -* 'Z' -- The whole matrix is packed as a band matrix. -* - IF( IPACK.EQ.5 ) - $ UUB = 0 - IF( IPACK.EQ.6 ) - $ LLB = 0 -* - DO 380 J = 1, UUB - DO 370 I = MIN( J+LLB, M ), 1, -1 - A( I-J+UUB+1, J ) = A( I, J ) - 370 CONTINUE - 380 CONTINUE -* - DO 400 J = UUB + 2, N - DO 390 I = J - UUB, MIN( J+LLB, M ) - A( I-J+UUB+1, J ) = A( I, J ) - 390 CONTINUE - 400 CONTINUE - END IF -* -* If packed, zero out extraneous elements. -* -* Symmetric/Triangular Packed -- -* zero out everything after A(IROW,ICOL) -* - IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN - DO 420 JC = ICOL, M - DO 410 JR = IROW + 1, LDA - A( JR, JC ) = ZERO - 410 CONTINUE - IROW = 0 - 420 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* Packed Band -- -* 1st row is now in A( UUB+2-j, j), zero above it -* m-th row is now in A( M+UUB-j,j), zero below it -* last non-zero diagonal is now in A( UUB+LLB+1,j ), -* zero below it, too. -* - IR1 = UUB + LLB + 2 - IR2 = UUB + M + 2 - DO 450 JC = 1, N - DO 430 JR = 1, UUB + 1 - JC - A( JR, JC ) = ZERO - 430 CONTINUE - DO 440 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA - A( JR, JC ) = ZERO - 440 CONTINUE - 450 CONTINUE - END IF - END IF -* - RETURN -* -* End of SLATMS -* - END diff --git a/testing/lin/slatrs.f b/testing/lin/slatrs.f deleted file mode 100644 index 34306960704634065719a5eb2982e7cda8725db5..0000000000000000000000000000000000000000 --- a/testing/lin/slatrs.f +++ /dev/null @@ -1,738 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, - $ CNORM, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, NORMIN, TRANS, UPLO - INTEGER INFO, LDA, N - REAL SCALE -* .. -* .. Array Arguments .. - REAL A( LDA, * ), CNORM( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* SLATRS solves one of the triangular systems -* -* A *x = s*b or A'*x = s*b -* -* with scaling to prevent overflow. Here A is an upper or lower -* triangular matrix, A' denotes the transpose of A, x and b are -* n-element vectors, and s is a scaling factor, usually less than -* or equal to 1, chosen so that the components of x will be less than -* the overflow threshold. If the unscaled problem will not cause -* overflow, the Level 2 BLAS routine STRSV is called. If the matrix A -* is singular (A(j,j) = 0 for some j), then s is set to 0 and a -* non-trivial solution to A*x = 0 is returned. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to A. -* = 'N': Solve A * x = s*b (No transpose) -* = 'T': Solve A'* x = s*b (Transpose) -* = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose) -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* NORMIN (input) CHARACTER*1 -* Specifies whether CNORM has been set or not. -* = 'Y': CNORM contains the column norms on entry -* = 'N': CNORM is not set on entry. On exit, the norms will -* be computed and stored in CNORM. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The triangular matrix A. If UPLO = 'U', the leading n by n -* upper triangular part of the array A contains the upper -* triangular matrix, and the strictly lower triangular part of -* A is not referenced. If UPLO = 'L', the leading n by n lower -* triangular part of the array A contains the lower triangular -* matrix, and the strictly upper triangular part of A is not -* referenced. If DIAG = 'U', the diagonal elements of A are -* also not referenced and are assumed to be 1. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max (1,N). -* -* X (input/output) REAL array, dimension (N) -* On entry, the right hand side b of the triangular system. -* On exit, X is overwritten by the solution vector x. -* -* SCALE (output) REAL -* The scaling factor s for the triangular system -* A * x = s*b or A'* x = s*b. -* If SCALE = 0, the matrix A is singular or badly scaled, and -* the vector x is an exact or approximate solution to A*x = 0. -* -* CNORM (input or output) REAL array, dimension (N) -* -* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) -* contains the norm of the off-diagonal part of the j-th column -* of A. If TRANS = 'N', CNORM(j) must be greater than or equal -* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) -* must be greater than or equal to the 1-norm. -* -* If NORMIN = 'N', CNORM is an output argument and CNORM(j) -* returns the 1-norm of the offdiagonal part of the j-th column -* of A. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* Further Details -* ======= ======= -* -* A rough bound on x is computed; if that is less than overflow, STRSV -* is called, otherwise, specific code is used which checks for possible -* overflow or divide-by-zero at every operation. -* -* A columnwise scheme is used for solving A*x = b. The basic algorithm -* if A is lower triangular is -* -* x[1:n] := b[1:n] -* for j = 1, ..., n -* x(j) := x(j) / A(j,j) -* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] -* end -* -* Define bounds on the components of x after j iterations of the loop: -* M(j) = bound on x[1:j] -* G(j) = bound on x[j+1:n] -* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. -* -* Then for iteration j+1 we have -* M(j+1) <= G(j) / | A(j+1,j+1) | -* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | -* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) -* -* where CNORM(j+1) is greater than or equal to the infinity-norm of -* column j+1 of A, not counting the diagonal. Hence -* -* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) -* 1<=i<=j -* and -* -* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) -* 1<=i< j -* -* Since |x(j)| <= M(j), we use the Level 2 BLAS routine STRSV if the -* reciprocal of the largest M(j), j=1,..,n, is larger than -* max(underflow, 1/overflow). -* -* The bound on x(j) is also used to determine when a step in the -* columnwise method can be performed without fear of overflow. If -* the computed bound is greater than a large constant, x is scaled to -* prevent overflow, but if the bound overflows, x is set to 0, x(j) to -* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. -* -* Similarly, a row-wise scheme is used to solve A'*x = b. The basic -* algorithm for A upper triangular is -* -* for j = 1, ..., n -* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) -* end -* -* We simultaneously compute two bounds -* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j -* M(j) = bound on x(i), 1<=i<=j -* -* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we -* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. -* Then the bound on x(j) is -* -* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | -* -* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) -* 1<=i<=j -* -* and we can safely call STRSV if 1/M(n) and 1/G(n) are both greater -* than max(underflow, 1/overflow). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, HALF, ONE - PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOTRAN, NOUNIT, UPPER - INTEGER I, IMAX, J, JFIRST, JINC, JLAST - REAL BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS, - $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ISAMAX - REAL SASUM, SDOT, SLAMCH - EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL SAXPY, SSCAL, STRSV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOTRAN = LSAME( TRANS, 'N' ) - NOUNIT = LSAME( DIAG, 'N' ) -* -* Test the input parameters. -* - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -3 - ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT. - $ LSAME( NORMIN, 'N' ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -5 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -7 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLATRS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine machine dependent parameters to control overflow. -* - SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - SCALE = ONE -* - IF( LSAME( NORMIN, 'N' ) ) THEN -* -* Compute the 1-norm of each column, not including the diagonal. -* - IF( UPPER ) THEN -* -* A is upper triangular. -* - DO 10 J = 1, N - CNORM( J ) = SASUM( J-1, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* A is lower triangular. -* - DO 20 J = 1, N - 1 - CNORM( J ) = SASUM( N-J, A( J+1, J ), 1 ) - 20 CONTINUE - CNORM( N ) = ZERO - END IF - END IF -* -* Scale the column norms by TSCAL if the maximum element in CNORM is -* greater than BIGNUM. -* - IMAX = ISAMAX( N, CNORM, 1 ) - TMAX = CNORM( IMAX ) - IF( TMAX.LE.BIGNUM ) THEN - TSCAL = ONE - ELSE - TSCAL = ONE / ( SMLNUM*TMAX ) - CALL SSCAL( N, TSCAL, CNORM, 1 ) - END IF -* -* Compute a bound on the computed solution vector to see if the -* Level 2 BLAS routine STRSV can be used. -* - J = ISAMAX( N, X, 1 ) - XMAX = ABS( X( J ) ) - XBND = XMAX - IF( NOTRAN ) THEN -* -* Compute the growth in A * x = b. -* - IF( UPPER ) THEN - JFIRST = N - JLAST = 1 - JINC = -1 - ELSE - JFIRST = 1 - JLAST = N - JINC = 1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 50 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, G(0) = max{x(i), i=1,...,n}. -* - GROW = ONE / MAX( XBND, SMLNUM ) - XBND = GROW - DO 30 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 50 -* -* M(j) = G(j-1) / abs(A(j,j)) -* - TJJ = ABS( A( J, J ) ) - XBND = MIN( XBND, MIN( ONE, TJJ )*GROW ) - IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN -* -* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) -* - GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) ) - ELSE -* -* G(j) could overflow, set GROW to 0. -* - GROW = ZERO - END IF - 30 CONTINUE - GROW = XBND - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) ) - DO 40 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 50 -* -* G(j) = G(j-1)*( 1 + CNORM(j) ) -* - GROW = GROW*( ONE / ( ONE+CNORM( J ) ) ) - 40 CONTINUE - END IF - 50 CONTINUE -* - ELSE -* -* Compute the growth in A' * x = b. -* - IF( UPPER ) THEN - JFIRST = 1 - JLAST = N - JINC = 1 - ELSE - JFIRST = N - JLAST = 1 - JINC = -1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 80 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, M(0) = max{x(i), i=1,...,n}. -* - GROW = ONE / MAX( XBND, SMLNUM ) - XBND = GROW - DO 60 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 80 -* -* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) -* - XJ = ONE + CNORM( J ) - GROW = MIN( GROW, XBND / XJ ) -* -* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) -* - TJJ = ABS( A( J, J ) ) - IF( XJ.GT.TJJ ) - $ XBND = XBND*( TJJ / XJ ) - 60 CONTINUE - GROW = MIN( GROW, XBND ) - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) ) - DO 70 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 80 -* -* G(j) = ( 1 + CNORM(j) )*G(j-1) -* - XJ = ONE + CNORM( J ) - GROW = GROW / XJ - 70 CONTINUE - END IF - 80 CONTINUE - END IF -* - IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN -* -* Use the Level 2 BLAS solve if the reciprocal of the bound on -* elements of X is not too small. -* - CALL STRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 ) - ELSE -* -* Use a Level 1 BLAS solve, scaling intermediate results. -* - IF( XMAX.GT.BIGNUM ) THEN -* -* Scale X so that its components are less than or equal to -* BIGNUM in absolute value. -* - SCALE = BIGNUM / XMAX - CALL SSCAL( N, SCALE, X, 1 ) - XMAX = BIGNUM - END IF -* - IF( NOTRAN ) THEN -* -* Solve A * x = b -* - DO 100 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) / A(j,j), scaling x if necessary. -* - XJ = ABS( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 95 - END IF - TJJ = ABS( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by 1/b(j). -* - REC = ONE / XJ - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = X( J ) / TJJS - XJ = ABS( X( J ) ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM -* to avoid overflow when dividing by A(j,j). -* - REC = ( TJJ*BIGNUM ) / XJ - IF( CNORM( J ).GT.ONE ) THEN -* -* Scale by 1/CNORM(j) to avoid overflow when -* multiplying x(j) times column j. -* - REC = REC / CNORM( J ) - END IF - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = X( J ) / TJJS - XJ = ABS( X( J ) ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A*x = 0. -* - DO 90 I = 1, N - X( I ) = ZERO - 90 CONTINUE - X( J ) = ONE - XJ = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 95 CONTINUE -* -* Scale x if necessary to avoid overflow when adding a -* multiple of column j of A. -* - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -* -* Scale x by 1/(2*abs(x(j))). -* - REC = REC*HALF - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - END IF - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -* -* Scale x by 1/2. -* - CALL SSCAL( N, HALF, X, 1 ) - SCALE = SCALE*HALF - END IF -* - IF( UPPER ) THEN - IF( J.GT.1 ) THEN -* -* Compute the update -* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) -* - CALL SAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X, - $ 1 ) - I = ISAMAX( J-1, X, 1 ) - XMAX = ABS( X( I ) ) - END IF - ELSE - IF( J.LT.N ) THEN -* -* Compute the update -* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) -* - CALL SAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1, - $ X( J+1 ), 1 ) - I = J + ISAMAX( N-J, X( J+1 ), 1 ) - XMAX = ABS( X( I ) ) - END IF - END IF - 100 CONTINUE -* - ELSE -* -* Solve A' * x = b -* - DO 140 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = ABS( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = ABS( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = USCAL / TJJS - END IF - IF( REC.LT.ONE ) THEN - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - SUMJ = ZERO - IF( USCAL.EQ.ONE ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call SDOT to perform the dot product. -* - IF( UPPER ) THEN - SUMJ = SDOT( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - SUMJ = SDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 110 I = 1, J - 1 - SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I ) - 110 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 120 I = J + 1, N - SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I ) - 120 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.TSCAL ) THEN -* -* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - SUMJ - XJ = ABS( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 135 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = ABS( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = X( J ) / TJJS - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL SSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = X( J ) / TJJS - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A'*x = 0. -* - DO 130 I = 1, N - X( I ) = ZERO - 130 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 135 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - sumj if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = X( J ) / TJJS - SUMJ - END IF - XMAX = MAX( XMAX, ABS( X( J ) ) ) - 140 CONTINUE - END IF - SCALE = SCALE / TSCAL - END IF -* -* Scale the column norms by 1/TSCAL for return. -* - IF( TSCAL.NE.ONE ) THEN - CALL SSCAL( N, ONE / TSCAL, CNORM, 1 ) - END IF -* - RETURN -* -* End of SLATRS -* - END diff --git a/testing/lin/slauu2.f b/testing/lin/slauu2.f deleted file mode 100644 index e870fe663bc794ef3782ef6127ce6711a205a05d..0000000000000000000000000000000000000000 --- a/testing/lin/slauu2.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SLAUU2 computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the unblocked form of the algorithm, calling Level 2 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I - REAL AII -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SDOT - EXTERNAL LSAME, SDOT -* .. -* .. External Subroutines .. - EXTERNAL SGEMV, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLAUU2', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = SDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA ) - CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), - $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 ) - ELSE - CALL SSCAL( I, AII, A( 1, I ), 1 ) - END IF - 10 CONTINUE -* - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = SDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 ) - CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, - $ A( I+1, I ), 1, AII, A( I, 1 ), LDA ) - ELSE - CALL SSCAL( I, AII, A( I, 1 ), LDA ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of SLAUU2 -* - END diff --git a/testing/lin/slauum.f b/testing/lin/slauum.f deleted file mode 100644 index e6d31d5cb0b6f766afbb358d3fcdf0f65d2d1a01..0000000000000000000000000000000000000000 --- a/testing/lin/slauum.f +++ /dev/null @@ -1,193 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLAUUM( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SLAUUM computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the blocked form of the algorithm, calling Level 3 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IB, NB -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLAUU2, SSYRK, STRMM, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SLAUUM', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'SLAUUM', UPLO, N, -1, -1, -1 ) -* - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL SLAUU2( UPLO, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL STRMM( 'Right', 'Upper', 'Transpose', 'Non-unit', - $ I-1, IB, ONE, A( I, I ), LDA, A( 1, I ), - $ LDA ) - CALL SLAUU2( 'Upper', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL SGEMM( 'No transpose', 'Transpose', I-1, IB, - $ N-I-IB+1, ONE, A( 1, I+IB ), LDA, - $ A( I, I+IB ), LDA, ONE, A( 1, I ), LDA ) - CALL SSYRK( 'Upper', 'No transpose', IB, N-I-IB+1, - $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ), - $ LDA ) - END IF - 10 CONTINUE - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL STRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB, - $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA ) - CALL SLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL SGEMM( 'Transpose', 'No transpose', IB, I-1, - $ N-I-IB+1, ONE, A( I+IB, I ), LDA, - $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA ) - CALL SSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE, - $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA ) - END IF - 20 CONTINUE - END IF - END IF -* - RETURN -* -* End of SLAUUM -* - END diff --git a/testing/lin/slqt01.f b/testing/lin/slqt01.f deleted file mode 100644 index 32909e7c30067ec9aff352276cf3163a229b8a79..0000000000000000000000000000000000000000 --- a/testing/lin/slqt01.f +++ /dev/null @@ -1,194 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLQT01( M, N, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SLQT01 tests SGELQF, which computes the LQ factorization of an m-by-n -* matrix A, and partially tests SORGLQ which forms the n-by-n -* orthogonal matrix Q. -* -* SLQT01 compares L with A*Q', and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) REAL array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by SGELQF. -* See SGELQF for further details. -* -* Q (output) REAL array, dimension (LDA,N) -* The n-by-n orthogonal matrix Q. -* -* L (workspace) REAL array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. -* LDA >= max(M,N). -* -* TAU (output) REAL array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by SGELQF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (max(M,N)) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL SLAMCH, SLANGE, SLANSY - EXTERNAL SLAMCH, SLANGE, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SGELQF, SGEMM, SLACPY, SLASET, SORGLQ, SSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'SGELQF' - CALL CHAMELEON_SGELQF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL SLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'SORGLQ' - CALL CHAMELEON_SORGLQ( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L -* - CALL SLASET( 'Full', M, N, ZERO, ZERO, L, LDA ) - CALL SLACPY( 'Lower', M, N, AF, LDA, L, LDA ) -* -* Compute L - A*Q' -* - CALL SGEMM( 'No transpose', 'Transpose', M, M, N, -ONE, A, LDA, Q, - $ LDA, ONE, L, LDA ) -* -* Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) . -* - ANORM = SLANGE( '1', M, N, A, LDA, RWORK ) - RESID = SLANGE( '1', M, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL SLASET( 'Full', M, M, ZERO, ONE, L, LDA ) - CALL SSYRK( 'Upper', 'No transpose', M, N, ONE, Q, LDA, -ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = SLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of SLQT01 -* - END diff --git a/testing/lin/slqt02.f b/testing/lin/slqt02.f deleted file mode 100644 index 22a6f61e8655cc3ae641498df43a75135e408387..0000000000000000000000000000000000000000 --- a/testing/lin/slqt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLQT02( M, N, K, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SLQT02 tests SORGLQ, which generates an m-by-n matrix Q with -* orthonornmal rows that is defined as the product of k elementary -* reflectors. -* -* Given the LQ factorization of an m-by-n matrix A, SLQT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and -* checks that the rows of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* N >= M >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. M >= K >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by SLQT01. -* -* AF (input) REAL array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by SGELQF. -* See SGELQF for further details. -* -* Q (workspace) REAL array, dimension (LDA,N) -* -* L (workspace) REAL array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. LDA >= N. -* -* TAU (input) REAL array, dimension (M) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL SLAMCH, SLANGE, SLANSY - EXTERNAL SLAMCH, SLANGE, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASET, SORGLQ, SSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - CALL SLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'SORGLQ' - CALL CHAMELEON_SORGLQ( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L(1:k,1:m) -* - CALL SLASET( 'Full', K, M, ZERO, ZERO, L, LDA ) - CALL SLACPY( 'Lower', K, M, AF, LDA, L, LDA ) -* -* Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' -* - CALL SGEMM( 'No transpose', 'Transpose', K, M, N, -ONE, A, LDA, Q, - $ LDA, ONE, L, LDA ) -* -* Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . -* - ANORM = SLANGE( '1', K, N, A, LDA, RWORK ) - RESID = SLANGE( '1', K, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL SLASET( 'Full', M, M, ZERO, ONE, L, LDA ) - CALL SSYRK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = SLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of SLQT02 -* - END diff --git a/testing/lin/slqt03.f b/testing/lin/slqt03.f deleted file mode 100644 index a4f04ca02ebb19bb984233c5abf4a16568cb21bd..0000000000000000000000000000000000000000 --- a/testing/lin/slqt03.f +++ /dev/null @@ -1,239 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SLQT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SLQT03 tests SORMLQ, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* SLQT03 compares the results of a call to SORMLQ with the results of -* forming Q explicitly by a call to SORGLQ and then performing matrix -* multiplication by a call to SGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows or columns of the matrix C; C is n-by-m if -* Q is applied from the left, or m-by-n if Q is applied from -* the right. M >= 0. -* -* N (input) INTEGER -* The order of the orthogonal matrix Q. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. N >= K >= 0. -* -* AF (input) REAL array, dimension (LDA,N) -* Details of the LQ factorization of an m-by-n matrix, as -* returned by SGELQF. See SGELQF for further details. -* -* C (workspace) REAL array, dimension (LDA,N) -* -* CC (workspace) REAL array, dimension (LDA,N) -* -* Q (workspace) REAL array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) REAL array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an n-by-n orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( N * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( N * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( N * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( N * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E0 ) - PARAMETER ( ZERO = 0.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - REAL CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE - EXTERNAL LSAME, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLARNV, SLASET, SORGLQ, SORMLQ -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL SLASET( 'Full', N, N, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDA ) - ENDIF -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'SORGLQ' - CALL CHAMELEON_SORGLQ( N, N, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = N - NC = M - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = M - NC = N - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL SLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - - CNORM = SLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.0.0 ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - END IF -* -* Copy C -* - CALL SLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'SORMLQ' - CALL CHAMELEON_SORMLQ( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) - -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL SGEMM( TRANS, 'No transpose', MC, NC, MC, -ONE, Q, - $ LDA, C, LDA, ONE, CC, LDA ) - ELSE - CALL SGEMM( 'No transpose', TRANS, MC, NC, NC, -ONE, C, - $ LDA, Q, LDA, ONE, CC, LDA ) - END IF - -* -* Compute error in the difference -* - RESID = SLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( REAL( MAX( 1, N ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of SLQT03 -* - END diff --git a/testing/lin/spocon.f b/testing/lin/spocon.f deleted file mode 100644 index 380896480399b19aeb1ccb731b54e7d5471e11d8..0000000000000000000000000000000000000000 --- a/testing/lin/spocon.f +++ /dev/null @@ -1,214 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call SLACN2 in place of SLACON, 7 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N - REAL ANORM, RCOND -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - REAL A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* SPOCON estimates the reciprocal of the condition number (in the -* 1-norm) of a real symmetric positive definite matrix using the -* Cholesky factorization A = U^T*U or A = L*L^T computed by SPOTRF. -* -* An estimate is obtained for norm(inv(A)), and the reciprocal of the -* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^T*U or A = L*L^T, as computed by SPOTRF. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* ANORM (input) REAL -* The 1-norm (or infinity-norm) of the symmetric matrix A. -* -* RCOND (output) REAL -* The reciprocal of the condition number of the matrix A, -* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an -* estimate of the 1-norm of inv(A) computed in this routine. -* -* WORK (workspace) REAL array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - CHARACTER NORMIN - INTEGER IX, KASE - REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ISAMAX - REAL SLAMCH - EXTERNAL LSAME, ISAMAX, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - ELSE IF( ANORM.LT.ZERO ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SPOCON', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - RCOND = ZERO - IF( N.EQ.0 ) THEN - RCOND = ONE - RETURN - ELSE IF( ANORM.EQ.ZERO ) THEN - RETURN - END IF -* - SMLNUM = SLAMCH( 'Safe minimum' ) -* -* Estimate the 1-norm of inv(A). -* - KASE = 0 - NORMIN = 'N' - 10 CONTINUE - CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( UPPER ) THEN -* -* Multiply by inv(U'). -* - CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, - $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) - NORMIN = 'Y' -* -* Multiply by inv(U). -* - CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) - ELSE -* -* Multiply by inv(L). -* - CALL SLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) - NORMIN = 'Y' -* -* Multiply by inv(L'). -* - CALL SLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A, - $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) - END IF -* -* Multiply by 1/SCALE if doing so will not cause overflow. -* - SCALE = SCALEL*SCALEU - IF( SCALE.NE.ONE ) THEN - IX = ISAMAX( N, WORK, 1 ) - IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) - $ GO TO 20 - CALL SRSCL( N, SCALE, WORK, 1 ) - END IF - GO TO 10 - END IF -* -* Compute the estimate of the reciprocal condition number. -* - IF( AINVNM.NE.ZERO ) - $ RCOND = ( ONE / AINVNM ) / ANORM -* - 20 CONTINUE - RETURN -* -* End of SPOCON -* - END diff --git a/testing/lin/spoequ.f b/testing/lin/spoequ.f deleted file mode 100644 index 47d842b938c50fdb111a0dde76a931f8d2deb10f..0000000000000000000000000000000000000000 --- a/testing/lin/spoequ.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOEQU( N, A, LDA, S, SCOND, AMAX, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, N - REAL AMAX, SCOND -* .. -* .. Array Arguments .. - REAL A( LDA, * ), S( * ) -* .. -* -* Purpose -* ======= -* -* SPOEQU computes row and column scalings intended to equilibrate a -* symmetric positive definite matrix A and reduce its condition number -* (with respect to the two-norm). S contains the scale factors, -* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with -* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This -* choice of S puts the condition number of B within a factor N of the -* smallest possible condition number over all possible diagonal -* scalings. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The N-by-N symmetric positive definite matrix whose scaling -* factors are to be computed. Only the diagonal elements of A -* are referenced. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* S (output) REAL array, dimension (N) -* If INFO = 0, S contains the scale factors for A. -* -* SCOND (output) REAL -* If INFO = 0, S contains the ratio of the smallest S(i) to -* the largest S(i). If SCOND >= 0.1 and AMAX is neither too -* large nor too small, it is not worth scaling by S. -* -* AMAX (output) REAL -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the i-th diagonal element is nonpositive. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I - REAL SMIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, SQRT -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -3 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SPOEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) THEN - SCOND = ONE - AMAX = ZERO - RETURN - END IF -* -* Find the minimum and maximum diagonal elements. -* - S( 1 ) = A( 1, 1 ) - SMIN = S( 1 ) - AMAX = S( 1 ) - DO 10 I = 2, N - S( I ) = A( I, I ) - SMIN = MIN( SMIN, S( I ) ) - AMAX = MAX( AMAX, S( I ) ) - 10 CONTINUE -* - IF( SMIN.LE.ZERO ) THEN -* -* Find the first non-positive diagonal element and return. -* - DO 20 I = 1, N - IF( S( I ).LE.ZERO ) THEN - INFO = I - RETURN - END IF - 20 CONTINUE - ELSE -* -* Set the scale factors to the reciprocals -* of the diagonal elements. -* - DO 30 I = 1, N - S( I ) = ONE / SQRT( S( I ) ) - 30 CONTINUE -* -* Compute SCOND = min(S(I)) / max(S(I)) -* - SCOND = SQRT( SMIN ) / SQRT( AMAX ) - END IF - RETURN -* -* End of SPOEQU -* - END diff --git a/testing/lin/sporfs.f b/testing/lin/sporfs.f deleted file mode 100644 index e633b09786fb03ae8d62a9dc7f53480700ad89b9..0000000000000000000000000000000000000000 --- a/testing/lin/sporfs.f +++ /dev/null @@ -1,379 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, - $ LDX, FERR, BERR, WORK, IWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call SLACN2 in place of SLACON, 7 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), FERR( * ), WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SPORFS improves the computed solution to a system of linear -* equations when the coefficient matrix is symmetric positive definite, -* and provides error bounds and backward error estimates for the -* solution. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The symmetric 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input) REAL array, dimension (LDAF,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^T*U or A = L*L^T, as computed by SPOTRF. -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* B (input) REAL array, dimension (LDB,NRHS) -* The right hand side matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input/output) REAL array, dimension (LDX,NRHS) -* On entry, the solution matrix X, as computed by SPOTRS. -* On exit, the improved solution matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* FERR (output) REAL array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) REAL array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* Internal Parameters -* =================== -* -* ITMAX is the maximum number of steps of iterative refinement. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - REAL ZERO - PARAMETER ( ZERO = 0.0E+0 ) - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) - REAL TWO - PARAMETER ( TWO = 2.0E+0 ) - REAL THREE - PARAMETER ( THREE = 3.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER COUNT, I, J, K, KASE, NZ, CHAMELEON_UPLO - REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SPOTRS, SSYMV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH - EXTERNAL LSAME, SLAMCH -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -7 - ELSE IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -9 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SPORFS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN - DO 10 J = 1, NRHS - FERR( J ) = ZERO - BERR( J ) = ZERO - 10 CONTINUE - RETURN - END IF -* - IF ( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* -* NZ = maximum number of nonzero elements in each row of A, plus 1 -* - NZ = N + 1 - EPS = SLAMCH( 'Epsilon' ) - SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN - SAFE2 = SAFE1 / EPS -* -* Do for each right hand side -* - DO 140 J = 1, NRHS -* - COUNT = 1 - LSTRES = THREE - 20 CONTINUE -* -* Loop until stopping criterion is satisfied. -* -* Compute residual R = B - A * X -* - CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL SSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, - $ WORK( N+1 ), 1 ) -* -* Compute componentwise relative backward error from formula -* -* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) ) -* -* where abs(Z) is the componentwise absolute value of the matrix -* or vector Z. If the i-th component of the denominator is less -* than SAFE2, then SAFE1 is added to the i-th components of the -* numerator and denominator before dividing. -* - DO 30 I = 1, N - WORK( I ) = ABS( B( I, J ) ) - 30 CONTINUE -* -* Compute abs(A)*abs(X) + abs(B). -* - IF( UPPER ) THEN - DO 50 K = 1, N - S = ZERO - XK = ABS( X( K, J ) ) - DO 40 I = 1, K - 1 - WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK - S = S + ABS( A( I, K ) )*ABS( X( I, J ) ) - 40 CONTINUE - WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK + S - 50 CONTINUE - ELSE - DO 70 K = 1, N - S = ZERO - XK = ABS( X( K, J ) ) - WORK( K ) = WORK( K ) + ABS( A( K, K ) )*XK - DO 60 I = K + 1, N - WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK - S = S + ABS( A( I, K ) )*ABS( X( I, J ) ) - 60 CONTINUE - WORK( K ) = WORK( K ) + S - 70 CONTINUE - END IF - S = ZERO - DO 80 I = 1, N - IF( WORK( I ).GT.SAFE2 ) THEN - S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) ) - ELSE - S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) / - $ ( WORK( I )+SAFE1 ) ) - END IF - 80 CONTINUE - BERR( J ) = S -* -* Test stopping criterion. Continue iterating if -* 1) The residual BERR(J) is larger than machine epsilon, and -* 2) BERR(J) decreased by at least a factor of 2 during the -* last iteration, and -* 3) At most ITMAX iterations tried. -* - IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND. - $ COUNT.LE.ITMAX ) THEN -* -* Update solution and try again. -* - CALL CHAMELEON_SPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 ) - LSTRES = BERR( J ) - COUNT = COUNT + 1 - GO TO 20 - END IF -* -* Bound error from formula -* -* norm(X - XTRUE) / norm(X) .le. FERR = -* norm( abs(inv(A))* -* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X) -* -* where -* norm(Z) is the magnitude of the largest component of Z -* inv(A) is the inverse of A -* abs(Z) is the componentwise absolute value of the matrix or -* vector Z -* NZ is the maximum number of nonzeros in any row of A, plus 1 -* EPS is machine epsilon -* -* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B)) -* is incremented by SAFE1 if the i-th component of -* abs(A)*abs(X) + abs(B) is less than SAFE2. -* -* Use SLACN2 to estimate the infinity-norm of the matrix -* inv(A) * diag(W), -* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) -* - DO 90 I = 1, N - IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) - ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 - END IF - 90 CONTINUE -* - KASE = 0 - 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), - $ KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( KASE.EQ.1 ) THEN -* -* Multiply by diag(W)*inv(A'). -* - CALL CHAMELEON_SPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - DO 110 I = 1, N - WORK( N+I ) = WORK( I )*WORK( N+I ) - 110 CONTINUE - ELSE IF( KASE.EQ.2 ) THEN -* -* Multiply by inv(A)*diag(W). -* - DO 120 I = 1, N - WORK( N+I ) = WORK( I )*WORK( N+I ) - 120 CONTINUE - CALL CHAMELEON_SPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK( N+1 ), N, INFO ) - END IF - GO TO 100 - END IF -* -* Normalize error. -* - LSTRES = ZERO - DO 130 I = 1, N - LSTRES = MAX( LSTRES, ABS( X( I, J ) ) ) - 130 CONTINUE - IF( LSTRES.NE.ZERO ) - $ FERR( J ) = FERR( J ) / LSTRES -* - 140 CONTINUE -* - RETURN -* -* End of SPORFS -* - END diff --git a/testing/lin/sposvx.f b/testing/lin/sposvx.f deleted file mode 100644 index 8a8f53564a41ab269f8016f8e691582e3057bd99..0000000000000000000000000000000000000000 --- a/testing/lin/sposvx.f +++ /dev/null @@ -1,423 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, - $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, - $ IWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK driver routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - INTEGER CHAMELEON_UPLO - REAL RCOND -* .. -* .. Array Arguments .. - INTEGER IWORK( * ) - REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), FERR( * ), S( * ), WORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SPOSVX uses the Cholesky factorization A = U^T*U or A = L*L^T to -* compute the solution to a real system of linear equations -* A * X = B, -* where A is an N-by-N symmetric positive definite matrix and X and B -* are N-by-NRHS matrices. -* -* Error bounds on the solution and a condition estimate are also -* provided. -* -* Description -* =========== -* -* The following steps are performed: -* -* 1. If FACT = 'E', real scaling factors are computed to equilibrate -* the system: -* diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B -* Whether or not the system will be equilibrated depends on the -* scaling of the matrix A, but if equilibration is used, A is -* overwritten by diag(S)*A*diag(S) and B by diag(S)*B. -* -* 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to -* factor the matrix A (after equilibration if FACT = 'E') as -* A = U^T* U, if UPLO = 'U', or -* A = L * L^T, if UPLO = 'L', -* where U is an upper triangular matrix and L is a lower triangular -* matrix. -* -* 3. If the leading i-by-i principal minor is not positive definite, -* then the routine returns with INFO = i. Otherwise, the factored -* form of A is used to estimate the condition number of the matrix -* A. If the reciprocal of the condition number is less than machine -* precision, INFO = N+1 is returned as a warning, but the routine -* still goes on to solve for X and compute error bounds as -* described below. -* -* 4. The system of equations is solved for X using the factored form -* of A. -* -* 5. Iterative refinement is applied to improve the computed solution -* matrix and calculate error bounds and backward error estimates -* for it. -* -* 6. If equilibration was used, the matrix X is premultiplied by -* diag(S) so that it solves the original system before -* equilibration. -* -* Arguments -* ========= -* -* FACT (input) CHARACTER*1 -* Specifies whether or not the factored form of the matrix A is -* supplied on entry, and if not, whether the matrix A should be -* equilibrated before it is factored. -* = 'F': On entry, AF contains the factored form of A. -* If EQUED = 'Y', the matrix A has been equilibrated -* with scaling factors given by S. A and AF will not -* be modified. -* = 'N': The matrix A will be copied to AF and factored. -* = 'E': The matrix A will be equilibrated if necessary, then -* copied to AF and factored. -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The number of linear equations, i.e., the order of the -* matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the symmetric matrix A, except if FACT = 'F' and -* EQUED = 'Y', then A must contain the equilibrated matrix -* diag(S)*A*diag(S). 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. A is not modified if -* FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit. -* -* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by -* diag(S)*A*diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input or output) REAL array, dimension (LDAF,N) -* If FACT = 'F', then AF is an input argument and on entry -* contains the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T, in the same storage -* format as A. If EQUED .ne. 'N', then AF is the factored form -* of the equilibrated matrix diag(S)*A*diag(S). -* -* If FACT = 'N', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T of the original -* matrix A. -* -* If FACT = 'E', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T of the equilibrated -* matrix A (see the description of A for the form of the -* equilibrated matrix). -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* EQUED (input or output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration (always true if FACT = 'N'). -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* EQUED is an input argument if FACT = 'F'; otherwise, it is an -* output argument. -* -* S (input or output) REAL array, dimension (N) -* The scale factors for A; not accessed if EQUED = 'N'. S is -* an input argument if FACT = 'F'; otherwise, S is an output -* argument. If FACT = 'F' and EQUED = 'Y', each element of S -* must be positive. -* -* B (input/output) REAL array, dimension (LDB,NRHS) -* On entry, the N-by-NRHS right hand side matrix B. -* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y', -* B is overwritten by diag(S) * B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (output) REAL array, dimension (LDX,NRHS) -* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to -* the original system of equations. Note that if EQUED = 'Y', -* A and B are modified on exit, and the solution to the -* equilibrated system is inv(diag(S))*X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* RCOND (output) REAL -* The estimate of the reciprocal condition number of the matrix -* A after equilibration (if done). If RCOND is less than the -* machine precision (in particular, if RCOND = 0), the matrix -* is singular to working precision. This condition is -* indicated by a return code of INFO > 0. -* -* FERR (output) REAL array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) REAL array, dimension (3*N) -* -* IWORK (workspace) INTEGER array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= N: the leading minor of order i of A is -* not positive definite, so the factorization -* could not be completed, and the solution has not -* been computed. RCOND = 0 is returned. -* = N+1: U is nonsingular, but RCOND is less than machine -* precision, meaning that the matrix is singular -* to working precision. Nevertheless, the -* solution and error bounds are computed because -* there are a number of situations where the -* computed solution can be more accurate than the -* value of RCOND would suggest. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, RCEQU - INTEGER I, INFEQU, J - REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANSY - EXTERNAL LSAME, SLAMCH, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SLACPY, SLAQSY, SPOCON, SPOEQU, SPORFS, SPOTRF, - $ SPOTRS, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - RCEQU = .FALSE. - ELSE - RCEQU = LSAME( EQUED, 'Y' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) - $ THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -9 - ELSE - IF( RCEQU ) THEN - SMIN = BIGNUM - SMAX = ZERO - DO 10 J = 1, N - SMIN = MIN( SMIN, S( J ) ) - SMAX = MAX( SMAX, S( J ) ) - 10 CONTINUE - IF( SMIN.LE.ZERO ) THEN - INFO = -10 - ELSE IF( N.GT.0 ) THEN - SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM ) - ELSE - SCOND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -12 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -14 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SPOSVX', -INFO ) - RETURN - END IF -* - IF( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL SPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) - RCEQU = LSAME( EQUED, 'Y' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( RCEQU ) THEN - DO 30 J = 1, NRHS - DO 20 I = 1, N - B( I, J ) = S( I )*B( I, J ) - 20 CONTINUE - 30 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the Cholesky factorization A = U'*U or A = L*L'. -* - CALL SLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CHAMELEON_SPOTRF( CHAMELEON_UPLO, N, AF, LDAF, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 )THEN - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A. -* - ANORM = SLANSY( '1', UPLO, N, A, LDA, WORK ) -* -* Compute the reciprocal of the condition number of A. -* - CALL SPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CHAMELEON_SPOTRS( CHAMELEON_UPLO, N, NRHS, AF, LDAF, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, - $ FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( RCEQU ) THEN - DO 50 J = 1, NRHS - DO 40 I = 1, N - X( I, J ) = S( I )*X( I, J ) - 40 CONTINUE - 50 CONTINUE - DO 60 J = 1, NRHS - FERR( J ) = FERR( J ) / SCOND - 60 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RETURN -* -* End of SPOSVX -* - END diff --git a/testing/lin/spot01.f b/testing/lin/spot01.f deleted file mode 100644 index 5643a73e12e2e308f15bed2eec56165c2300d13a..0000000000000000000000000000000000000000 --- a/testing/lin/spot01.f +++ /dev/null @@ -1,197 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAFAC, N - REAL RESID -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AFAC( LDAFAC, * ), RWORK( * ) -* .. -* -* Purpose -* ======= -* -* SPOT01 reconstructs a symmetric positive definite matrix A from -* its L*L' or U'*U factorization and computes the residual -* norm( L*L' - A ) / ( N * norm(A) * EPS ) or -* norm( U'*U - A ) / ( N * norm(A) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AFAC (input/output) REAL array, dimension (LDAFAC,N) -* On entry, the factor L or U from the L*L' or U'*U -* factorization of A. -* Overwritten with the reconstructed matrix, and then with the -* difference L*L' - A (or U'*U - A). -* -* LDAFAC (input) INTEGER -* The leading dimension of the array AFAC. LDAFAC >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RESID (output) REAL -* If UPLO = 'L', norm(L*L' - A) / ( N * norm(A) * EPS ) -* If UPLO = 'U', norm(U'*U - A) / ( N * norm(A) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J, K - REAL ANORM, EPS, T -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SDOT, SLAMCH, SLANSY - EXTERNAL LSAME, SDOT, SLAMCH, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SSCAL, SSYR, STRMV -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute the product U'*U, overwriting U. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 10 K = N, 1, -1 -* -* Compute the (K,K) element of the result. -* - T = SDOT( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) - AFAC( K, K ) = T -* -* Compute the rest of column K. -* - CALL STRMV( 'Upper', 'Transpose', 'Non-unit', K-1, AFAC, - $ LDAFAC, AFAC( 1, K ), 1 ) -* - 10 CONTINUE -* -* Compute the product L*L', overwriting L. -* - ELSE - DO 20 K = N, 1, -1 -* -* Add a multiple of column K of the factor L to each of -* columns K+1 through N. -* - IF( K+1.LE.N ) - $ CALL SSYR( 'Lower', N-K, ONE, AFAC( K+1, K ), 1, - $ AFAC( K+1, K+1 ), LDAFAC ) -* -* Scale column K by the diagonal element. -* - T = AFAC( K, K ) - CALL SSCAL( N-K+1, T, AFAC( K, K ), 1 ) -* - 20 CONTINUE - END IF -* -* Compute the difference L*L' - A (or U'*U - A). -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 40 J = 1, N - DO 30 I = 1, J - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 30 CONTINUE - 40 CONTINUE - ELSE - DO 60 J = 1, N - DO 50 I = J, N - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) -* - RESID = SLANSY( '1', UPLO, N, AFAC, LDAFAC, RWORK ) -* - RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS -* - RETURN -* -* End of SPOT01 -* - END diff --git a/testing/lin/spot02.f b/testing/lin/spot02.f deleted file mode 100644 index eef2caf24dce89985ef669c2dcf592bc8b428c14..0000000000000000000000000000000000000000 --- a/testing/lin/spot02.f +++ /dev/null @@ -1,171 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, - $ RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SPOT02 computes the residual for the solution of a symmetric system -* of linear equations A*x = b: -* -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* X (input) REAL array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* B (input/output) REAL array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER J - REAL ANORM, BNORM, EPS, RHSNORM, XNORM -* .. -* .. External Functions .. - REAL SASUM, SLAMCH, SLANSY, SLANGE - EXTERNAL SASUM, SLAMCH, SLANSY, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SSYMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) - RHSNORM = SLANGE( '1', N, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X -* - CALL SSYMM( 'Left', UPLO, N, NRHS, -ONE, A, LDA, X, LDX, ONE, B, - $ LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SASUM( N, B( 1, J ), 1 ) - XNORM = SASUM( N, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM ) / (( ANORM * XNORM + RHSNORM)* - $ N* EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of SPOT02 -* - END diff --git a/testing/lin/spot03.f b/testing/lin/spot03.f deleted file mode 100644 index 755442b0af28f38f480c6b0c4ef6241a177c36e6..0000000000000000000000000000000000000000 --- a/testing/lin/spot03.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOT03( UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, - $ RWORK, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAINV, LDWORK, N - REAL RCOND, RESID -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AINV( LDAINV, * ), RWORK( * ), - $ WORK( LDWORK, * ) -* .. -* -* Purpose -* ======= -* -* SPOT03 computes the residual for a symmetric matrix times its -* inverse: -* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The original symmetric matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AINV (input/output) REAL array, dimension (LDAINV,N) -* On entry, the inverse of the matrix A, stored as a symmetric -* matrix in the same format as A. -* In this version, AINV is expanded into a full matrix and -* multiplied by A, so the opposing triangle of AINV will be -* changed; i.e., if the upper triangular part of AINV is -* stored, the lower triangular part will be used as work space. -* -* LDAINV (input) INTEGER -* The leading dimension of the array AINV. LDAINV >= max(1,N). -* -* WORK (workspace) REAL array, dimension (LDWORK,N) -* -* LDWORK (input) INTEGER -* The leading dimension of the array WORK. LDWORK >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (N) -* -* RCOND (output) REAL -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(AINV). -* -* RESID (output) REAL -* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - REAL AINVNM, ANORM, EPS -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE, SLANSY - EXTERNAL LSAME, SLAMCH, SLANGE, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SSYMM -* .. -* .. Intrinsic Functions .. - INTRINSIC REAL -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RCOND = ONE - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. -* - EPS = SLAMCH( 'Epsilon' ) - ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) - AINVNM = SLANSY( '1', UPLO, N, AINV, LDAINV, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCOND = ZERO - RESID = ONE / EPS - RETURN - END IF - RCOND = ( ONE / ANORM ) / AINVNM -* -* Expand AINV into a full matrix and call SSYMM to multiply -* AINV on the left by A. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - AINV( J, I ) = AINV( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE - DO 40 J = 1, N - DO 30 I = J + 1, N - AINV( J, I ) = AINV( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - CALL SSYMM( 'Left', UPLO, N, N, -ONE, A, LDA, AINV, LDAINV, ZERO, - $ WORK, LDWORK ) -* -* Add the identity matrix to WORK . -* - DO 50 I = 1, N - WORK( I, I ) = WORK( I, I ) + ONE - 50 CONTINUE -* -* Compute norm(I - A*AINV) / (N * norm(A) * norm(AINV) * EPS) -* - RESID = SLANGE( '1', N, N, WORK, LDWORK, RWORK ) -* - RESID = ( ( RESID*RCOND ) / EPS ) / REAL( N ) -* - RETURN -* -* End of SPOT03 -* - END diff --git a/testing/lin/spot05.f b/testing/lin/spot05.f deleted file mode 100644 index 401aaa0dbb2601181246509bd9e9e147fb2340d8..0000000000000000000000000000000000000000 --- a/testing/lin/spot05.f +++ /dev/null @@ -1,242 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOT05( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, - $ LDXACT, FERR, BERR, RESLTS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, LDXACT, N, NRHS -* .. -* .. Array Arguments .. - REAL A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ), - $ RESLTS( * ), X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* SPOT05 tests the error bounds from iterative refinement for the -* computed solution to a system of equations A*X = B, where A is a -* symmetric n by n matrix. -* -* RESLTS(1) = test of the error bound -* = norm(X - XACT) / ( norm(X) * FERR ) -* -* A large value is returned if this ratio is not less than one. -* -* RESLTS(2) = residual from the iterative refinement routine -* = the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows of the matrices X, B, and XACT, and the -* order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X, B, and XACT. -* NRHS >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The symmetric 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* B (input) REAL array, dimension (LDB,NRHS) -* The right hand side vectors for the system of linear -* equations. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input) REAL array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) REAL array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* FERR (input) REAL array, dimension (NRHS) -* The estimated forward error bounds for each solution vector -* X. If XTRUE is the true solution, FERR bounds the magnitude -* of the largest entry in (X - XTRUE) divided by the magnitude -* of the largest entry in X. -* -* BERR (input) REAL array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector (i.e., the smallest relative change in any entry of A -* or B that makes X an exact solution). -* -* RESLTS (output) REAL array, dimension (2) -* The maximum over the NRHS solution vectors of the ratios: -* RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR ) -* RESLTS(2) = BERR / ( (n+1)*EPS + (*) ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IMAX, J, K - REAL AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ISAMAX - REAL SLAMCH - EXTERNAL LSAME, ISAMAX, SLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESLTS( 1 ) = ZERO - RESLTS( 2 ) = ZERO - RETURN - END IF -* - EPS = SLAMCH( 'Epsilon' ) - UNFL = SLAMCH( 'Safe minimum' ) - OVFL = ONE / UNFL - UPPER = LSAME( UPLO, 'U' ) -* -* Test 1: Compute the maximum of -* norm(X - XACT) / ( norm(X) * FERR ) -* over all the vectors X and XACT using the infinity-norm. -* - ERRBND = ZERO - DO 30 J = 1, NRHS - IMAX = ISAMAX( N, X( 1, J ), 1 ) - XNORM = MAX( ABS( X( IMAX, J ) ), UNFL ) - DIFF = ZERO - DO 10 I = 1, N - DIFF = MAX( DIFF, ABS( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE -* - IF( XNORM.GT.ONE ) THEN - GO TO 20 - ELSE IF( DIFF.LE.OVFL*XNORM ) THEN - GO TO 20 - ELSE - ERRBND = ONE / EPS - GO TO 30 - END IF -* - 20 CONTINUE - IF( DIFF / XNORM.LE.FERR( J ) ) THEN - ERRBND = MAX( ERRBND, ( DIFF / XNORM ) / FERR( J ) ) - ELSE - ERRBND = ONE / EPS - END IF - 30 CONTINUE - RESLTS( 1 ) = ERRBND -* -* Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* - DO 90 K = 1, NRHS - DO 80 I = 1, N - TMP = ABS( B( I, K ) ) - IF( UPPER ) THEN - DO 40 J = 1, I - TMP = TMP + ABS( A( J, I ) )*ABS( X( J, K ) ) - 40 CONTINUE - DO 50 J = I + 1, N - TMP = TMP + ABS( A( I, J ) )*ABS( X( J, K ) ) - 50 CONTINUE - ELSE - DO 60 J = 1, I - 1 - TMP = TMP + ABS( A( I, J ) )*ABS( X( J, K ) ) - 60 CONTINUE - DO 70 J = I, N - TMP = TMP + ABS( A( J, I ) )*ABS( X( J, K ) ) - 70 CONTINUE - END IF - IF( I.EQ.1 ) THEN - AXBI = TMP - ELSE - AXBI = MIN( AXBI, TMP ) - END IF - 80 CONTINUE - TMP = BERR( K ) / ( ( N+1 )*EPS+( N+1 )*UNFL / - $ MAX( AXBI, ( N+1 )*UNFL ) ) - IF( K.EQ.1 ) THEN - RESLTS( 2 ) = TMP - ELSE - RESLTS( 2 ) = MAX( RESLTS( 2 ), TMP ) - END IF - 90 CONTINUE -* - RETURN -* -* End of SPOT05 -* - END diff --git a/testing/lin/spotri.f b/testing/lin/spotri.f deleted file mode 100644 index d52f05699f40fcb185e124cee9005e390c9db15d..0000000000000000000000000000000000000000 --- a/testing/lin/spotri.f +++ /dev/null @@ -1,133 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SPOTRI( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SPOTRI computes the inverse of a real symmetric positive definite -* matrix A using the Cholesky factorization A = U^T*U or A = L*L^T -* computed by SPOTRF. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the triangular factor U or L from the Cholesky -* factorization A = U^T*U or A = L*L^T, as computed by -* SPOTRF. -* On exit, the upper or lower triangle of the (symmetric) -* inverse of A, overwriting the input factor U or L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the (i,i) element of the factor U or L is -* zero, and the inverse could not be computed. -* -* ===================================================================== -* -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL SLAUUM, STRTRI, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SPOTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Invert the triangular Cholesky factor U or L. -* - CALL STRTRI( UPLO, 'Non-unit', N, A, LDA, INFO ) - IF( INFO.GT.0 ) - $ RETURN -* -* Form inv(U)*inv(U)' or inv(L)'*inv(L). -* - CALL SLAUUM( UPLO, N, A, LDA, INFO ) -* - RETURN -* -* End of SPOTRI -* - END diff --git a/testing/lin/sqrt01.f b/testing/lin/sqrt01.f deleted file mode 100644 index 8ad7ce8bf26825e82e7181f1f3646406a4f9958b..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt01.f +++ /dev/null @@ -1,194 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT01( M, N, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SQRT01 tests SGEQRF, which computes the QR factorization of an m-by-n -* matrix A, and partially tests SORGQR which forms the m-by-m -* orthogonal matrix Q. -* -* SQRT01 compares R with Q'*A, and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) REAL array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by SGEQRF. -* See SGEQRF for further details. -* -* Q (output) REAL array, dimension (LDA,M) -* The m-by-m orthogonal matrix Q. -* -* R (workspace) REAL array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. -* LDA >= max(M,N). -* -* TAU (output) REAL array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by SGEQRF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL SLAMCH, SLANGE, SLANSY - EXTERNAL SLAMCH, SLANGE, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SGEQRF, SLACPY, SLASET, SORGQR, SSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'SGEQRF' - CALL CHAMELEON_SGEQRF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL SLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'SORGQR' - CALL CHAMELEON_SORGQR( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R -* - CALL SLASET( 'Full', N, N, ZERO, ZERO, R, LDA ) - CALL SLACPY( 'Upper', N, N, AF, LDA, R, LDA ) -* -* Compute R - Q'*A -* - CALL SGEMM( 'Transpose', 'No transpose', N, N, M, -ONE, Q, LDA, A, - $ LDA, ONE, R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = SLANGE( '1', M, N, A, LDA, RWORK ) - RESID = SLANGE( '1', N, N, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL SLASET( 'Full', N, N, ZERO, ONE, R, LDA ) - CALL SSYRK( 'Upper', 'Transpose', N, M, ONE, Q, LDA, -ONE, R, - $ LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = SLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of SQRT01 -* - END diff --git a/testing/lin/sqrt02.f b/testing/lin/sqrt02.f deleted file mode 100644 index 2e7a4c1131ca74b59656b68a64a01ba3010b2284..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt02.f +++ /dev/null @@ -1,190 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT02( M, N, K, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T(2) -* .. -* .. Array Arguments .. - REAL A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SQRT02 tests SORGQR, which generates an m-by-n matrix Q with -* orthonornmal columns that is defined as the product of k elementary -* reflectors. -* -* Given the QR factorization of an m-by-n matrix A, SQRT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* columns of A; it compares R(1:n,1:k) with Q(1:m,1:n)'*A(1:m,1:k), -* and checks that the columns of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* M >= N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. N >= K >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by SQRT01. -* -* AF (input) REAL array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by SGEQRF. -* See SGEQRF for further details. -* -* Q (workspace) REAL array, dimension (LDA,N) -* -* R (workspace) REAL array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. LDA >= M. -* -* TAU (input) REAL array, dimension (N) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - INTEGER INFO - REAL ANORM, EPS, RESID -* .. -* .. External Functions .. - REAL SLAMCH, SLANGE, SLANSY - EXTERNAL SLAMCH, SLANGE, SLANSY -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASET, SORGQR, SSYRK -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) -* -* Copy the first k columns of the factorization to the array Q -* - CALL SLASET( 'Full', M, N, ZERO, ONE, Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'SORGQR' - CALL CHAMELEON_SORGQR( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R(1:n,1:k) -* - CALL SLASET( 'Full', N, K, ZERO, ZERO, R, LDA ) - CALL SLACPY( 'Upper', N, K, AF, LDA, R, LDA ) -* -* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) -* - CALL SGEMM( 'Transpose', 'No transpose', N, K, M, -ONE, Q, LDA, A, - $ LDA, ONE, R, LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = SLANGE( '1', M, K, A, LDA, RWORK ) - RESID = SLANGE( '1', N, K, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / REAL( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL SLASET( 'Full', N, N, ZERO, ONE, R, LDA ) - CALL SSYRK( 'Upper', 'Transpose', N, M, -ONE, Q, LDA, ONE, R, - $ LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = SLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / REAL( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of SQRT02 -* - END diff --git a/testing/lin/sqrt03.f b/testing/lin/sqrt03.f deleted file mode 100644 index 2b24311053848d633fc9869a733e040ae8040c65..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt03.f +++ /dev/null @@ -1,237 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - REAL AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), RESULT( * ), RWORK( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SQRT03 tests SORMQR, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* SQRT03 compares the results of a call to SORMQR with the results of -* forming Q explicitly by a call to SORGQR and then performing matrix -* multiplication by a call to SGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The order of the orthogonal matrix Q. M >= 0. -* -* N (input) INTEGER -* The number of rows or columns of the matrix C; C is m-by-n if -* Q is applied from the left, or n-by-m if Q is applied from -* the right. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. M >= K >= 0. -* -* AF (input) REAL array, dimension (LDA,N) -* Details of the QR factorization of an m-by-n matrix, as -* returnedby SGEQRF. See SGEQRF for further details. -* -* C (workspace) REAL array, dimension (LDA,N) -* -* CC (workspace) REAL array, dimension (LDA,N) -* -* Q (workspace) REAL array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) REAL array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESULT (output) REAL array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an m-by-m orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( M * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( M * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( M * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( M * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E0 ) - PARAMETER ( ZERO = 0.0E+0 ) - REAL ROGUE - PARAMETER ( ROGUE = -1.0E+10 ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - REAL CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE - EXTERNAL LSAME, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLARNV, SLASET, SORGQR, SORMQR -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, REAL -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = SLAMCH( 'Epsilon' ) - WORK(1) = ONE -* -* Copy the first k columns of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL SLASET( 'Full', M, M, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL SLASET( 'Full', M, M, ZERO, ONE, Q, LDA ) - ENDIF -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'SORGQR' - CALL CHAMELEON_SORGQR( M, M, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = M - NC = N - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = N - NC = M - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL SLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = SLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.0.0 ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'T' - CHAMELEON_TRANS = CHAMELEONTRANS - END IF -* -* Copy C -* - CALL SLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'SORMQR' - CALL CHAMELEON_SORMQR( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL SLASET( 'Full', M, M, ZERO, ONE, Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL SGEMM( TRANS, 'No transpose', MC, NC, MC, -ONE, Q, - $ LDA, C, LDA, ONE, CC, LDA ) - ELSE - CALL SGEMM( 'No transpose', TRANS, MC, NC, NC, -ONE, C, - $ LDA, Q, LDA, ONE, CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = SLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( REAL( MAX( 1, M ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of SQRT03 -* - END diff --git a/testing/lin/sqrt13.f b/testing/lin/sqrt13.f deleted file mode 100644 index 8c85fd326b124c418fc4533a563a65b8f9dd3a68..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt13.f +++ /dev/null @@ -1,153 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, M, N, SCALE - REAL NORMA -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* SQRT13 generates a full-rank matrix that may be scaled to have large -* or small norm. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (output) REAL array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* NORMA (output) REAL -* The one-norm of A. -* -* ISEED (input/output) integer array, dimension (4) -* Seed for random number generator -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J - REAL BIGNUM, SMLNUM -* .. -* .. External Functions .. - REAL SASUM, SLAMCH, SLANGE - EXTERNAL SASUM, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SLABAD, SLARNV, SLASCL -* .. -* .. Intrinsic Functions .. - INTRINSIC SIGN -* .. -* .. Local Arrays .. - REAL DUMMY( 1 ) -* .. -* .. Executable Statements .. -* - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN -* -* benign matrix -* - DO 10 J = 1, N - CALL SLARNV( 2, ISEED, M, A( 1, J ) ) - IF( J.LE.M ) THEN - A( J, J ) = A( J, J ) + SIGN( SASUM( M, A( 1, J ), 1 ), - $ A( J, J ) ) - END IF - 10 CONTINUE -* -* scaled versions -* - IF( SCALE.NE.1 ) THEN - NORMA = SLANGE( 'Max', M, N, A, LDA, DUMMY ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / SLAMCH( 'Epsilon' ) - BIGNUM = ONE / SMLNUM -* - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL SLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA, - $ INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL SLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA, - $ INFO ) - END IF - END IF -* - NORMA = SLANGE( 'One-norm', M, N, A, LDA, DUMMY ) - RETURN -* -* End of SQRT13 -* - END diff --git a/testing/lin/sqrt14.f b/testing/lin/sqrt14.f deleted file mode 100644 index 9e7ca06d025ed78a795a5c5c73ca833d5531620b..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt14.f +++ /dev/null @@ -1,228 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SQRT14( TRANS, M, N, NRHS, A, LDA, X, - $ LDX, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - REAL A( LDA, * ), WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SQRT14 checks whether X is in the row space of A or A'. It does so -* by scaling both X and A such that their norms are in the range -* [sqrt(eps), 1/sqrt(eps)], then computing a QR factorization of [A,X] -* (if TRANS = 'T') or an LQ factorization of [A',X]' (if TRANS = 'N'), -* and returning the norm of the trailing triangle, scaled by -* MAX(M,N,NRHS)*eps. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* = 'N': No transpose, check for X in the row space of A -* = 'T': Transpose, check for X in the row space of A'. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of X. -* -* A (input) REAL array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* X (input) REAL array, dimension (LDX,NRHS) -* If TRANS = 'N', the N-by-NRHS matrix X. -* IF TRANS = 'T', the M-by-NRHS matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* -* WORK (workspace) REAL array dimension (LWORK) -* -* LWORK (input) INTEGER -* length of workspace array required -* If TRANS = 'N', LWORK >= (M+NRHS)*(N+2); -* if TRANS = 'T', LWORK >= (N+NRHS)*(M+2). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL TPSD - INTEGER I, INFO, J, LDWORK - REAL ANRM, ERR, XNRM -* .. -* .. Local Arrays .. - REAL RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE - EXTERNAL LSAME, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGELQ2, SGEQR2, SLACPY, SLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, REAL -* .. -* .. Executable Statements .. -* - SQRT14 = ZERO - IF( LSAME( TRANS, 'N' ) ) THEN - LDWORK = M + NRHS - TPSD = .FALSE. - IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN - CALL XERBLA( 'SQRT14', 10 ) - RETURN - ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE IF( LSAME( TRANS, 'T' ) ) THEN - LDWORK = M - TPSD = .TRUE. - IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN - CALL XERBLA( 'SQRT14', 10 ) - RETURN - ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE - CALL XERBLA( 'SQRT14', 1 ) - RETURN - END IF -* -* Copy and scale A -* - CALL SLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) - ANRM = SLANGE( 'M', M, N, WORK, LDWORK, RWORK ) - IF( ANRM.NE.ZERO ) - $ CALL SLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) -* -* Copy X or X' into the right place and scale it -* - IF( TPSD ) THEN -* -* Copy X into columns n+1:n+nrhs of work -* - CALL SLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), - $ LDWORK ) - XNRM = SLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, - $ RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL SLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, - $ WORK( N*LDWORK+1 ), LDWORK, INFO ) - ANRM = SLANGE( 'One-norm', M, N+NRHS, WORK, LDWORK, RWORK ) -* -* Compute QR factorization of X -* - CALL SGEQR2( M, N+NRHS, WORK, LDWORK, - $ WORK( LDWORK*( N+NRHS )+1 ), - $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), - $ INFO ) -* -* Compute largest entry in upper triangle of -* work(n+1:m,n+1:n+nrhs) -* - ERR = ZERO - DO 20 J = N + 1, N + NRHS - DO 10 I = N + 1, MIN( M, J ) - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) - 10 CONTINUE - 20 CONTINUE -* - ELSE -* -* Copy X' into rows m+1:m+nrhs of work -* - DO 40 I = 1, N - DO 30 J = 1, NRHS - WORK( M+J+( I-1 )*LDWORK ) = X( I, J ) - 30 CONTINUE - 40 CONTINUE -* - XNRM = SLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL SLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), - $ LDWORK, INFO ) -* -* Compute LQ factorization of work -* - CALL SGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), - $ WORK( LDWORK*( N+1 )+1 ), INFO ) -* -* Compute largest entry in lower triangle in -* work(m+1:m+nrhs,m+1:n) -* - ERR = ZERO - DO 60 J = M + 1, N - DO 50 I = J, LDWORK - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) - 50 CONTINUE - 60 CONTINUE -* - END IF -* - SQRT14 = ERR / ( REAL( MAX( M, N, NRHS ) )*SLAMCH( 'Epsilon' ) ) -* - RETURN -* -* End of SQRT14 -* - END diff --git a/testing/lin/sqrt15.f b/testing/lin/sqrt15.f deleted file mode 100644 index cead2fb0e5cd202a788588b627ddd943249b843f..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt15.f +++ /dev/null @@ -1,264 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, - $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE - REAL NORMA, NORMB -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* SQRT15 generates a matrix with full or deficient rank and of various -* norms. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* RKSEL (input) INTEGER -* RKSEL = 1: full rank matrix -* RKSEL = 2: rank-deficient matrix -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* NRHS (input) INTEGER -* The number of columns of B. -* -* A (output) REAL array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* B (output) REAL array, dimension (LDB, NRHS) -* A matrix that is in the range space of matrix A. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* -* S (output) REAL array, dimension MIN(M,N) -* Singular values of A. -* -* RANK (output) INTEGER -* number of nonzero singular values of A. -* -* NORMA (output) REAL -* one-norm of A. -* -* NORMB (output) REAL -* one-norm of B. -* -* ISEED (input/output) integer array, dimension (4) -* seed for random number generator. -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* length of work space required. -* LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M) -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE, TWO, SVMIN - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0, - $ SVMIN = 0.1E0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J, MN - REAL BIGNUM, EPS, SMLNUM, TEMP -* .. -* .. Local Arrays .. - REAL DUMMY( 1 ) -* .. -* .. External Functions .. - REAL SASUM, SLAMCH, SLANGE, SLARND, SNRM2 - EXTERNAL SASUM, SLAMCH, SLANGE, SLARND, SNRM2 -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLAORD, SLARF, SLARNV, SLAROR, SLASCL, - $ SLASET, SSCAL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - MN = MIN( M, N ) - IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN - CALL XERBLA( 'SQRT15', 16 ) - RETURN - END IF -* - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - EPS = SLAMCH( 'Epsilon' ) - SMLNUM = ( SMLNUM / EPS ) / EPS - BIGNUM = ONE / SMLNUM -* -* Determine rank and (unscaled) singular values -* - IF( RKSEL.EQ.1 ) THEN - RANK = MN - ELSE IF( RKSEL.EQ.2 ) THEN - RANK = ( 3*MN ) / 4 - DO 10 J = RANK + 1, MN - S( J ) = ZERO - 10 CONTINUE - ELSE - CALL XERBLA( 'SQRT15', 2 ) - END IF -* - IF( RANK.GT.0 ) THEN -* -* Nontrivial case -* - S( 1 ) = ONE - DO 30 J = 2, RANK - 20 CONTINUE - TEMP = SLARND( 1, ISEED ) - IF( TEMP.GT.SVMIN ) THEN - S( J ) = ABS( TEMP ) - ELSE - GO TO 20 - END IF - 30 CONTINUE - CALL SLAORD( 'Decreasing', RANK, S, 1 ) -* -* Generate 'rank' columns of a random orthogonal matrix in A -* - CALL SLARNV( 2, ISEED, M, WORK ) - CALL SSCAL( M, ONE / SNRM2( M, WORK, 1 ), WORK, 1 ) - CALL SLASET( 'Full', M, RANK, ZERO, ONE, A, LDA ) - CALL SLARF( 'Left', M, RANK, WORK, 1, TWO, A, LDA, - $ WORK( M+1 ) ) -* -* workspace used: m+mn -* -* Generate consistent rhs in the range space of A -* - CALL SLARNV( 2, ISEED, RANK*NRHS, WORK ) - CALL SGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, ONE, - $ A, LDA, WORK, RANK, ZERO, B, LDB ) -* -* work space used: <= mn *nrhs -* -* generate (unscaled) matrix A -* - DO 40 J = 1, RANK - CALL SSCAL( M, S( J ), A( 1, J ), 1 ) - 40 CONTINUE - IF( RANK.LT.N ) - $ CALL SLASET( 'Full', M, N-RANK, ZERO, ZERO, A( 1, RANK+1 ), - $ LDA ) - CALL SLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, - $ WORK, INFO ) -* - ELSE -* -* work space used 2*n+m -* -* Generate null matrix and rhs -* - DO 50 J = 1, MN - S( J ) = ZERO - 50 CONTINUE - CALL SLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) - CALL SLASET( 'Full', M, NRHS, ZERO, ZERO, B, LDB ) -* - END IF -* -* Scale the matrix -* - IF( SCALE.NE.1 ) THEN - NORMA = SLANGE( 'Max', M, N, A, LDA, DUMMY ) - IF( NORMA.NE.ZERO ) THEN - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL SLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, - $ LDA, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, - $ MN, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL SLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, - $ LDA, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, - $ MN, INFO ) - CALL SLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE - CALL XERBLA( 'SQRT15', 1 ) - RETURN - END IF - END IF - END IF -* - NORMA = SASUM( MN, S, 1 ) - NORMB = SLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) -* - RETURN -* -* End of SQRT15 -* - END diff --git a/testing/lin/sqrt16.f b/testing/lin/sqrt16.f deleted file mode 100644 index ad843315cf2c1629a1eaf884954d227dda992221..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt16.f +++ /dev/null @@ -1,180 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SQRT16( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - REAL RESID -* .. -* .. Array Arguments .. - REAL A( LDA, * ), B( LDB, * ), RWORK( * ), - $ X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SQRT16 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ norm(NRHS)) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A'*x = b, where A' is the transpose of A -* = 'C': A'*x = b, where A' is the transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) REAL array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) REAL array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) REAL array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) REAL array, dimension (M) -* -* RESID (output) REAL -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * norm(A) * norm(X) * EPS ). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - REAL ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SASUM, SLAMCH, SLANGE - EXTERNAL LSAME, SASUM, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - ANORM = SLANGE( 'I', M, N, A, LDA, RWORK ) - N1 = N - N2 = M - ELSE - ANORM = SLANGE( '1', M, N, A, LDA, RWORK ) - N1 = M - N2 = N - END IF -* - RHSNORM = SLANGE( 'I', N, NRHS, B, LDB, RWORK ) - EPS = SLAMCH( 'Epsilon' ) -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL SGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X, - $ LDX, ONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = SASUM( N1, B( 1, J ), 1 ) - XNORM = SASUM( N2, X( 1, J ), 1 ) - IF( ANORM.EQ.ZERO .AND. BNORM.EQ.ZERO ) THEN - RESID = ZERO - ELSE IF( ANORM.LE.ZERO .OR. XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / (ANORM * XNORM + RHSNORM ) * - $ ( MAX( M, N )*EPS ) ) - END IF - 10 CONTINUE -* - RETURN -* -* End of SQRT16 -* - END diff --git a/testing/lin/sqrt17.f b/testing/lin/sqrt17.f deleted file mode 100644 index 174881f041377091d6ba51b548328a438498cafe..0000000000000000000000000000000000000000 --- a/testing/lin/sqrt17.f +++ /dev/null @@ -1,217 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - REAL FUNCTION SQRT17( TRANS, IRESID, M, N, NRHS, A, - $ LDA, X, LDX, B, LDB, C, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER IRESID, LDA, LDB, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - REAL A( LDA, * ), B( LDB, * ), C( LDB, * ), - $ WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* SQRT17 computes the ratio -* -* || R'*op(A) ||/(||A||*alpha*max(M,N,NRHS)*eps) -* -* where R = op(A)*X - B, op(A) is A or A', and -* -* alpha = ||B|| if IRESID = 1 (zero-residual problem) -* alpha = ||R|| if IRESID = 2 (otherwise). -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies whether or not the transpose of A is used. -* = 'N': No transpose, op(A) = A. -* = 'T': Transpose, op(A) = A'. -* -* IRESID (input) INTEGER -* IRESID = 1 indicates zero-residual problem. -* IRESID = 2 indicates non-zero residual. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* If TRANS = 'N', the number of rows of the matrix B. -* If TRANS = 'T', the number of rows of the matrix X. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* If TRANS = 'N', the number of rows of the matrix X. -* If TRANS = 'T', the number of rows of the matrix B. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and B. -* -* A (input) REAL array, dimension (LDA,N) -* The m-by-n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* X (input) REAL array, dimension (LDX,NRHS) -* If TRANS = 'N', the n-by-nrhs matrix X. -* If TRANS = 'T', the m-by-nrhs matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* If TRANS = 'N', LDX >= N. -* If TRANS = 'T', LDX >= M. -* -* B (input) REAL array, dimension (LDB,NRHS) -* If TRANS = 'N', the m-by-nrhs matrix B. -* If TRANS = 'T', the n-by-nrhs matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* If TRANS = 'N', LDB >= M. -* If TRANS = 'T', LDB >= N. -* -* C (workspace) REAL array, dimension (LDB,NRHS) -* -* WORK (workspace) REAL array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of the array WORK. LWORK >= NRHS*(M+N). -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, ISCL, NCOLS, NROWS - REAL BIGNUM, ERR, NORMA, NORMB, NORMRS, NORMX, - $ SMLNUM -* .. -* .. Local Arrays .. - REAL RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE - EXTERNAL LSAME, SLAMCH, SLANGE -* .. -* .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASCL, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, REAL -* .. -* .. Executable Statements .. -* - SQRT17 = ZERO -* - IF( LSAME( TRANS, 'N' ) ) THEN - NROWS = M - NCOLS = N - ELSE IF( LSAME( TRANS, 'T' ) ) THEN - NROWS = N - NCOLS = M - ELSE - CALL XERBLA( 'SQRT17', 1 ) - RETURN - END IF -* - IF( LWORK.LT.NCOLS*NRHS ) THEN - CALL XERBLA( 'SQRT17', 13 ) - RETURN - END IF -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF -* - NORMA = SLANGE( 'One-norm', M, N, A, LDA, RWORK ) - SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - ISCL = 0 -* -* compute residual and scale it -* - CALL SLACPY( 'All', NROWS, NRHS, B, LDB, C, LDB ) - CALL SGEMM( TRANS, 'No transpose', NROWS, NRHS, NCOLS, -ONE, A, - $ LDA, X, LDX, ONE, C, LDB ) - NORMRS = SLANGE( 'Max', NROWS, NRHS, C, LDB, RWORK ) - IF( NORMRS.GT.SMLNUM ) THEN - ISCL = 1 - CALL SLASCL( 'General', 0, 0, NORMRS, ONE, NROWS, NRHS, C, LDB, - $ INFO ) - END IF -* -* compute R'*A -* - CALL SGEMM( 'Transpose', TRANS, NRHS, NCOLS, NROWS, ONE, C, LDB, - $ A, LDA, ZERO, WORK, NRHS ) -* -* compute and properly scale error -* - ERR = SLANGE( 'One-norm', NRHS, NCOLS, WORK, NRHS, RWORK ) - IF( NORMA.NE.ZERO ) - $ ERR = ERR / NORMA -* - IF( ISCL.EQ.1 ) - $ ERR = ERR*NORMRS -* - IF( IRESID.EQ.1 ) THEN - NORMB = SLANGE( 'One-norm', NROWS, NRHS, B, LDB, RWORK ) - IF( NORMB.NE.ZERO ) - $ ERR = ERR / NORMB - ELSE - NORMX = SLANGE( 'One-norm', NCOLS, NRHS, X, LDX, RWORK ) - IF( NORMX.NE.ZERO ) - $ ERR = ERR / NORMX - END IF -* - SQRT17 = ERR / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N, NRHS ) ) ) - RETURN -* -* End of SQRT17 -* - END diff --git a/testing/lin/srscl.f b/testing/lin/srscl.f deleted file mode 100644 index 31e593fa2d5256ef2ab1eac617cfd8e18e2e25e0..0000000000000000000000000000000000000000 --- a/testing/lin/srscl.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE SRSCL( N, SA, SX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N - REAL SA -* .. -* .. Array Arguments .. - REAL SX( * ) -* .. -* -* Purpose -* ======= -* -* SRSCL multiplies an n-element real vector x by the real scalar 1/a. -* This is done without overflow or underflow as long as -* the final result x/a does not overflow or underflow. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of components of the vector x. -* -* SA (input) REAL -* The scalar a which is used to divide each component of x. -* SA must be >= 0, or the subroutine will divide by zero. -* -* SX (input/output) REAL array, dimension -* (1+(N-1)*abs(INCX)) -* The n-element vector x. -* -* INCX (input) INTEGER -* The increment between successive values of the vector SX. -* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM -* .. -* .. External Functions .. - REAL SLAMCH - EXTERNAL SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL SLABAD, SSCAL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = SLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) -* -* Initialize the denominator to SA and the numerator to 1. -* - CDEN = SA - CNUM = ONE -* - 10 CONTINUE - CDEN1 = CDEN*SMLNUM - CNUM1 = CNUM / BIGNUM - IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN -* -* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. -* - MUL = SMLNUM - DONE = .FALSE. - CDEN = CDEN1 - ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN -* -* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. -* - MUL = BIGNUM - DONE = .FALSE. - CNUM = CNUM1 - ELSE -* -* Multiply X by CNUM / CDEN and return. -* - MUL = CNUM / CDEN - DONE = .TRUE. - END IF -* -* Scale the vector X by MUL -* - CALL SSCAL( N, MUL, SX, INCX ) -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of SRSCL -* - END diff --git a/testing/lin/stest.in b/testing/lin/stest.in deleted file mode 100644 index a5b1ded805fdd64620c8ce4c5a6213391b23c644..0000000000000000000000000000000000000000 --- a/testing/lin/stest.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing REAL CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -0 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -SGE 11 List types on next line if 0 < NTYPES < 11 -SPO 9 List types on next line if 0 < NTYPES < 9 -SLS 6 List types on next line if 0 < NTYPES < 6 -SQR 8 List types on next line if 0 < NTYPES < 8 -SLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/stestdyn.in b/testing/lin/stestdyn.in deleted file mode 100644 index 6ce7b98a9325a597cca845504b4ebd90502d184c..0000000000000000000000000000000000000000 --- a/testing/lin/stestdyn.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing REAL CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -1 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -SGE 11 List types on next line if 0 < NTYPES < 11 -SPO 9 List types on next line if 0 < NTYPES < 9 -SLS 6 List types on next line if 0 < NTYPES < 6 -SQR 8 List types on next line if 0 < NTYPES < 8 -SLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/strti2.f b/testing/lin/strti2.f deleted file mode 100644 index 041ce833694729624982e9a13dfcd35eb83cc87b..0000000000000000000000000000000000000000 --- a/testing/lin/strti2.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE STRTI2( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* STRTI2 computes the inverse of a real upper or lower triangular -* matrix. -* -* This is the Level 2 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading n by n upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading n by n lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J - REAL AJJ -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL SSCAL, STRMV, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'STRTI2', -INFO ) - RETURN - END IF -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix. -* - DO 10 J = 1, N - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF -* -* Compute elements 1:j-1 of j-th column. -* - CALL STRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA, - $ A( 1, J ), 1 ) - CALL SSCAL( J-1, AJJ, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix. -* - DO 20 J = N, 1, -1 - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF - IF( J.LT.N ) THEN -* -* Compute elements j+1:n of j-th column. -* - CALL STRMV( 'Lower', 'No transpose', DIAG, N-J, - $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) - CALL SSCAL( N-J, AJJ, A( J+1, J ), 1 ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of STRTI2 -* - END diff --git a/testing/lin/strtri.f b/testing/lin/strtri.f deleted file mode 100644 index 2507baf8165cc41cc5b04fb7398d4863beee37aa..0000000000000000000000000000000000000000 --- a/testing/lin/strtri.f +++ /dev/null @@ -1,214 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - REAL A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* STRTRI computes the inverse of a real upper or lower triangular -* matrix A. -* -* This is the Level 3 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': A is upper triangular; -* = 'L': A is lower triangular. -* -* DIAG (input) CHARACTER*1 -* = 'N': A is non-unit triangular; -* = 'U': A is unit triangular. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) REAL array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading N-by-N upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading N-by-N lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, A(i,i) is exactly zero. The triangular -* matrix is singular and its inverse can not be computed. -* -* ===================================================================== -* -* .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J, JB, NB, NN -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL STRMM, STRSM, STRTI2, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'STRTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Check for singularity if non-unit. -* - IF( NOUNIT ) THEN - DO 10 INFO = 1, N - IF( A( INFO, INFO ).EQ.ZERO ) - $ RETURN - 10 CONTINUE - INFO = 0 - END IF -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL STRTI2( UPLO, DIAG, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix -* - DO 20 J = 1, N, NB - JB = MIN( NB, N-J+1 ) -* -* Compute rows 1:j-1 of current block column -* - CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, - $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, - $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) -* -* Compute inverse of current diagonal block -* - CALL STRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) - 20 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix -* - NN = ( ( N-1 ) / NB )*NB + 1 - DO 30 J = NN, 1, -NB - JB = MIN( NB, N-J+1 ) - IF( J+JB.LE.N ) THEN -* -* Compute rows j+jb:n of current block column -* - CALL STRMM( 'Left', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, - $ A( J+JB, J ), LDA ) - CALL STRSM( 'Right', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, - $ A( J+JB, J ), LDA ) - END IF -* -* Compute inverse of current diagonal block -* - CALL STRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) - 30 CONTINUE - END IF - END IF -* - RETURN -* -* End of STRTRI -* - END diff --git a/testing/lin/xerbla.f b/testing/lin/xerbla.f deleted file mode 100644 index f751e1be4732c3423e8a5a6ffcb14344d8e6b3bf..0000000000000000000000000000000000000000 --- a/testing/lin/xerbla.f +++ /dev/null @@ -1,124 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE XERBLA( SRNAME, INFO ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*(*) SRNAME - INTEGER INFO -* .. -* -* Purpose -* ======= -* -* This is a special version of XERBLA to be used only as part of -* the test program for testing error exits from the LAPACK routines. -* Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRMANT, -* where INFOT and SRNAMT are values stored in COMMON. -* -* Arguments -* ========= -* -* SRNAME (input) CHARACTER*(*) -* The name of the subroutine calling XERBLA. This name should -* match the COMMON variable SRNAMT. -* -* INFO (input) INTEGER -* The error return code from the calling subroutine. INFO -* should equal the COMMON variable INFOT. -* -* Further Details -* ======= ======= -* -* The following variables are passed via the common blocks INFOC and -* SRNAMC: -* -* INFOT INTEGER Expected integer return code -* NOUT INTEGER Unit number for printing error messages -* OK LOGICAL Set to .TRUE. if INFO = INFOT and -* SRNAME = SRNAMT, otherwise set to .FALSE. -* LERR LOGICAL Set to .TRUE., indicating that XERBLA was called -* SRNAMT CHARACTER*(*) Expected name of calling subroutine -* -* -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Intrinsic Functions .. - INTRINSIC LEN_TRIM -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - LERR = .TRUE. - IF( INFO.NE.INFOT ) THEN - IF( INFOT.NE.0 ) THEN - WRITE( NOUT, FMT = 9999 ) - $ SRNAMT( 1:LEN_TRIM( SRNAMT ) ), INFO, INFOT - ELSE - WRITE( NOUT, FMT = 9997 ) - $ SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO - END IF - OK = .FALSE. - END IF - IF( SRNAME.NE.SRNAMT ) THEN - WRITE( NOUT, FMT = 9998 ) - $ SRNAME( 1:LEN_TRIM( SRNAME ) ), - $ SRNAMT( 1:LEN_TRIM( SRNAMT ) ) - OK = .FALSE. - END IF - RETURN -* - 9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6, - $ ' instead of ', I2, ' ***' ) - 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A, - $ ' instead of ', A6, ' ***' ) - 9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6, - $ ' had an illegal value ***' ) -* -* End of XERBLA -* - END diff --git a/testing/lin/xlaenv.f b/testing/lin/xlaenv.f deleted file mode 100644 index 30472e03ab7813ad3e0d5c1e504678fde0dfcf9a..0000000000000000000000000000000000000000 --- a/testing/lin/xlaenv.f +++ /dev/null @@ -1,109 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE XLAENV( ISPEC, NVALUE ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER ISPEC, NVALUE -* .. -* -* Purpose -* ======= -* -* XLAENV sets certain machine- and problem-dependent quantities -* which will later be retrieved by ILAENV. -* -* Arguments -* ========= -* -* ISPEC (input) INTEGER -* Specifies the parameter to be set in the COMMON array IPARMS. -* = 1: the optimal blocksize; if this value is 1, an unblocked -* algorithm will give the best performance. -* = 2: the minimum block size for which the block routine -* should be used; if the usable block size is less than -* this value, an unblocked routine should be used. -* = 3: the crossover point (in a block routine, for N less -* than this value, an unblocked routine should be used) -* = 4: the number of shifts, used in the nonsymmetric -* eigenvalue routines -* = 5: the minimum column dimension for blocking to be used; -* rectangular blocks must have dimension at least k by m, -* where k is given by ILAENV(2,...) and m by CHAMELEON_ -* ILAENV(5,...) -* = 6: the crossover point for the SVD (when reducing an m by n -* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds -* this value, a QR factorization is used first to reduce -* the matrix to a triangular form) -* = 7: the number of processors -* = 8: another crossover point, for the multishift QR and QZ -* methods for nonsymmetric eigenvalue problems. -* = 9: maximum size of the subproblems at the bottom of the -* computation tree in the divide-and-conquer algorithm -* (used by xGELSD and xGESDD) -* =10: ieee NaN arithmetic can be trusted not to trap -* =11: infinity arithmetic can be trusted not to trap -* -* NVALUE (input) INTEGER -* The value of the parameter specified by ISPEC. -* -* ===================================================================== -* -* .. Arrays in Common .. - INTEGER IPARMS( 100 ) -* .. -* .. Common blocks .. - COMMON / CLAENV / IPARMS -* .. -* .. Save statement .. - SAVE / CLAENV / -* .. -* .. Executable Statements .. -* - IF( ISPEC.GE.1 .AND. ISPEC.LE.9 ) THEN - IPARMS( ISPEC ) = NVALUE - END IF -* - RETURN -* -* End of XLAENV -* - END diff --git a/testing/lin/zchkaa.f b/testing/lin/zchkaa.f deleted file mode 100644 index 0e83f48661d53d255eed31f3e799a92e2f2d094f..0000000000000000000000000000000000000000 --- a/testing/lin/zchkaa.f +++ /dev/null @@ -1,637 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - PROGRAM ZCHKAA -* - INCLUDE 'chameleon_fortran.h' -* -* -- CHAMELEON test routine (From LAPACK version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* Purpose -* ======= -* -* ZCHKAA is the main test program for the COMPLEX*16 linear equation -* routines. -* -* The program must be driven by a short data file. The first 14 records -* specify problem dimensions and program options using list-directed -* input. The remaining lines specify the CHAMELEON test paths and the -* number of matrix types to use in testing. An annotated example of a -* data file can be obtained by deleting the first 3 characters from the -* following 38 lines: -* Data file for testing COMPLEX*16 CHAMELEON linear equation routines -* 1 Number of values of NP -* 16 Values of NP (number of cores) -* 1 Values of SCHED (0: STATIC, 1:DYNAMIC) -* 7 Number of values of M -* 0 1 2 3 5 10 16 Values of M (row dimension) -* 7 Number of values of N -* 0 1 2 3 5 10 16 Values of N (column dimension) -* 1 Number of values of NRHS -* 2 Values of NRHS (number of right hand sides) -* 5 Number of values of NB -* 1 3 3 3 20 Values of NB (the blocksize) -* 1 0 5 9 1 Values of NX (crossover point) -* 3 Number of values of RANK -* 30 50 90 Values of rank (as a % of N) -* 30.0 Threshold value of test ratio -* T Put T to test the CHAMELEON routines -* T Put T to test the driver routines -* T Put T to test the error exits -* ZGE 11 List types on next line if 0 < NTYPES < 11 -* ZGB 8 List types on next line if 0 < NTYPES < 8 -* ZGT 12 List types on next line if 0 < NTYPES < 12 -* ZPO 9 List types on next line if 0 < NTYPES < 9 -* ZPS 9 List types on next line if 0 < NTYPES < 9 -* ZPP 9 List types on next line if 0 < NTYPES < 9 -* ZPB 8 List types on next line if 0 < NTYPES < 8 -* ZPT 12 List types on next line if 0 < NTYPES < 12 -* ZHE 10 List types on next line if 0 < NTYPES < 10 -* ZHP 10 List types on next line if 0 < NTYPES < 10 -* ZSY 11 List types on next line if 0 < NTYPES < 11 -* ZSP 11 List types on next line if 0 < NTYPES < 11 -* ZTR 18 List types on next line if 0 < NTYPES < 18 -* ZTP 18 List types on next line if 0 < NTYPES < 18 -* ZTB 17 List types on next line if 0 < NTYPES < 17 -* ZQR 8 List types on next line if 0 < NTYPES < 8 -* ZRQ 8 List types on next line if 0 < NTYPES < 8 -* ZLQ 8 List types on next line if 0 < NTYPES < 8 -* ZQL 8 List types on next line if 0 < NTYPES < 8 -* ZQP 6 List types on next line if 0 < NTYPES < 6 -* ZTZ 3 List types on next line if 0 < NTYPES < 3 -* ZLS 6 List types on next line if 0 < NTYPES < 6 -* ZEQ -* -* Internal Parameters -* =================== -* -* NMAX INTEGER -* The maximum allowable value for N. -* -* MAXIN INTEGER -* The number of different values that can be used for each of -* M, N, or NB -* -* MAXRHS INTEGER -* The maximum number of right hand sides -* -* NIN INTEGER -* The unit number for input -* -* NOUT INTEGER -* The unit number for output -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NPMAX - PARAMETER ( NPMAX = 16 ) - INTEGER NMAX - PARAMETER ( NMAX = 1000 ) - INTEGER MAXIN - PARAMETER ( MAXIN = 12 ) - INTEGER MAXRHS - PARAMETER ( MAXRHS = 16 ) - INTEGER MATMAX - PARAMETER ( MATMAX = 30 ) - INTEGER NIN, NOUT - PARAMETER ( NIN = 5, NOUT = 6 ) - INTEGER KDMAX - PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) -* .. -* .. Local Scalars .. - LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR - CHARACTER C1 - CHARACTER*2 C2 - CHARACTER*3 PATH - CHARACTER*10 INTSTR - CHARACTER*72 ALINE - INTEGER I, IB, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, - $ NN, NNB, NNB2, NP, NNP, SCHED, NNS, NRHS, - $ NTYPES, NRANK, VERS_MAJOR, VERS_MINOR, - $ VERS_PATCH, INFO - DOUBLE PRECISION EPS, S1, S2, THREQ, THRESH -* .. -* .. Local Arrays .. - LOGICAL DOTYPE( MATMAX ) - INTEGER IBVAL(MAXIN ), IWORK( 25*NMAX ), MVAL( MAXIN ), - $ NBVAL( MAXIN ), NBVAL2( MAXIN ), - $ NPVAL( MAXIN ), NSVAL( MAXIN ), - $ NVAL( MAXIN ), NXVAL( MAXIN ), - $ RANKVAL( MAXIN ), PIV( NMAX ) - DOUBLE PRECISION RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX ) - COMPLEX*16 A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), - $ WORK( NMAX, NMAX+MAXRHS+10 ) -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - DOUBLE PRECISION DLAMCH, DSECND - EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND -* .. -* .. External Subroutines .. - EXTERNAL ALAREQ, ZCHKGE, - $ ZCHKLQ, ZCHKPO, - $ ZCHKQR, - $ ZDRVLS, - $ ZDRVPO, - $ ILAVER -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Arrays in Common .. - INTEGER IPARMS( 100 ) -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT - COMMON / CLAENV / IPARMS -* .. -* .. Data statements .. - DATA THREQ / 2.0D0 / , INTSTR / '0123456789' / -* .. -* .. Executable Statements .. -* -* S1 = DSECND( ) - LDA = NMAX - FATAL = .FALSE. -* -* Report values of parameters. -* - CALL CHAMELEON_VERSION( VERS_MAJOR, VERS_MINOR, VERS_PATCH, INFO) - WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH -* -* -* Read a dummy line. -* - READ( NIN, FMT = * ) -* -* Read the values of NP -* - READ( NIN, FMT = * )NNP - IF( NNP.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNP ', NNP, 1 - NNP = 0 - FATAL = .TRUE. - ELSE IF( NNP.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNP ', NNP, MAXIN - NNP = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NPVAL( I ), I = 1, NNP ) - DO 01 I = 1, NNP - IF( NPVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NP ', NPVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NPVAL( I ).GT.NPMAX ) THEN - WRITE( NOUT, FMT = 9995 )' NP ', NPVAL( I ), NPMAX - FATAL = .TRUE. - END IF - 01 CONTINUE - IF( NNP.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NP ', ( NPVAL( I ), I = 1, NNP ) -* -* Read the values of SCHED -* - READ( NIN, FMT = * )SCHED - IF (( SCHED .LT. 0 ) .OR. (SCHED .GT. 1)) THEN - WRITE( NOUT, FMT = 9987 )' SCHED ', SCHED - SCHED = 0 - FATAL = .TRUE. - END IF -* -* Read the values of M -* - READ( NIN, FMT = * )NM - IF( NM.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 - NM = 0 - FATAL = .TRUE. - ELSE IF( NM.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN - NM = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) - DO 10 I = 1, NM - IF( MVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( MVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX - FATAL = .TRUE. - END IF - 10 CONTINUE - IF( NM.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) -* -* Read the values of N -* - READ( NIN, FMT = * ) NN - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 - NN = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN - NN = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) - DO 20 I = 1, NN - IF( NVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NVAL( I ).GT.NMAX ) THEN - WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX - FATAL = .TRUE. - END IF - 20 CONTINUE - IF( NN.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) -* -* Read the values of NRHS -* - READ( NIN, FMT = * )NNS - IF( NNS.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 - NNS = 0 - FATAL = .TRUE. - ELSE IF( NNS.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN - NNS = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) - DO 30 I = 1, NNS - IF( NSVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN - WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS - FATAL = .TRUE. - END IF - 30 CONTINUE - IF( NNS.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) -* -* Read the values of NB -* - READ( NIN, FMT = * )NNB - IF( NNB.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 - NNB = 0 - FATAL = .TRUE. - ELSE IF( NNB.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN - NNB = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) - DO 40 I = 1, NNB - IF( NBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 - FATAL = .TRUE. - END IF - 40 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) -* -* Read the values of IB -* - READ( NIN, FMT = * )( IBVAL( I ), I = 1, NNB ) - DO 41 I = 1, NNB - IF( IBVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NB ', IBVAL( I ), 0 - FATAL = .TRUE. - END IF - 41 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'IB ', ( IBVAL( I ), I = 1, NNB ) -* -* Set NBVAL2 to be the set of unique values of NB -* - NNB2 = 0 - DO 60 I = 1, NNB - NB = NBVAL( I ) - DO 50 J = 1, NNB2 - IF( NB.EQ.NBVAL2( J ) ) - $ GO TO 60 - 50 CONTINUE - NNB2 = NNB2 + 1 - NBVAL2( NNB2 ) = NB - 60 CONTINUE -* -* Read the values of NX -* - READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) - DO 70 I = 1, NNB - IF( NXVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 - FATAL = .TRUE. - END IF - 70 CONTINUE - IF( NNB.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) -* -* Read the values of RANKVAL -* - READ( NIN, FMT = * )NRANK - IF( NN.LT.1 ) THEN - WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 - NRANK = 0 - FATAL = .TRUE. - ELSE IF( NN.GT.MAXIN ) THEN - WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN - NRANK = 0 - FATAL = .TRUE. - END IF - READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) - DO I = 1, NRANK - IF( RANKVAL( I ).LT.0 ) THEN - WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 - FATAL = .TRUE. - ELSE IF( RANKVAL( I ).GT.100 ) THEN - WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 - FATAL = .TRUE. - END IF - END DO - IF( NRANK.GT.0 ) - $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', - $ ( RANKVAL( I ), I = 1, NRANK ) -* -* Read the threshold value for the test ratios. -* - READ( NIN, FMT = * )THRESH - WRITE( NOUT, FMT = 9992 )THRESH -* -* Read the flag that indicates whether to test the CHAMELEON routines. -* - READ( NIN, FMT = * )TSTCHK -* -* Read the flag that indicates whether to test the driver routines. -* - READ( NIN, FMT = * )TSTDRV -* -* Read the flag that indicates whether to test the error exits. -* - READ( NIN, FMT = * )TSTERR -* - IF( FATAL ) THEN - WRITE( NOUT, FMT = 9999 ) - STOP - END IF -* -* Calculate and print the machine dependent constants. -* - EPS = DLAMCH( 'Underflow threshold' ) - WRITE( NOUT, FMT = 9991 )'underflow', EPS - EPS = DLAMCH( 'Overflow threshold' ) - WRITE( NOUT, FMT = 9991 )'overflow ', EPS - EPS = DLAMCH( 'Epsilon' ) - WRITE( NOUT, FMT = 9991 )'precision', EPS - WRITE( NOUT, FMT = * ) - NRHS = NSVAL( 1 ) -* -* Initialize CHAMELEON -* - CALL CHAMELEON_INIT( NPVAL(NNP), INFO ) -* - IF( SCHED .EQ. 1 ) THEN - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_DYNAMIC_SCHEDULING, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_SCHEDULING_MODE, - $ CHAMELEON_STATIC_SCHEDULING, INFO ) - ENDIF -* - CALL CHAMELEON_DISABLE( CHAMELEON_AUTOTUNING, INFO ) -* -* - 80 CONTINUE -* -* Read a test path and the number of matrix types to use. -* - READ( NIN, FMT = '(A72)', END = 140 )ALINE - PATH = ALINE( 1: 3 ) - NMATS = MATMAX - I = 3 - 90 CONTINUE - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - IF( ALINE( I: I ).EQ.' ' ) - $ GO TO 90 - NMATS = 0 - 100 CONTINUE - C1 = ALINE( I: I ) - DO 110 K = 1, 10 - IF( C1.EQ.INTSTR( K: K ) ) THEN - IC = K - 1 - GO TO 120 - END IF - 110 CONTINUE - GO TO 130 - 120 CONTINUE - NMATS = NMATS*10 + IC - I = I + 1 - IF( I.GT.72 ) - $ GO TO 130 - GO TO 100 - 130 CONTINUE - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) -* -* Check first character for correct precision. -* - IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN - WRITE( NOUT, FMT = 9990 )PATH -* - ELSE IF( NMATS.LE.0 ) THEN -* -* Check for a positive number of tests requested. -* - WRITE( NOUT, FMT = 9989 )PATH -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* GE: general matrices -* - NTYPES = 11 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL ZCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), - $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* PO: positive definite matrices -* - NTYPES = 9 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL ZCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, - $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), - $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ WORK, RWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - IF( TSTDRV ) THEN - CALL ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, - $ RWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9988 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN -* -* QR: QR factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL ZCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN -* -* LQ: LQ factorization -* - NTYPES = 8 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTCHK ) THEN - CALL ZCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* LS: Least squares drivers -* - NTYPES = 6 - CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) -* - IF( TSTDRV ) THEN - CALL ZDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ IBVAL, NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), - $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ S( 1 ), S( NMAX+1 ), WORK, RWORK, IWORK, - $ NOUT ) - ELSE - WRITE( NOUT, FMT = 9989 )PATH - END IF -* - ELSE -* - WRITE( NOUT, FMT = 9990 )PATH - END IF -* -* Go back to get another input line. -* - GO TO 80 -* -* Branch to this line when the last record is read. -* - 140 CONTINUE - CLOSE ( NIN ) -* -* Finalize CHAMELEON -* - CALL CHAMELEON_FINALIZE( INFO ) -* S2 = DSECND( ) - WRITE( NOUT, FMT = 9998 ) -* WRITE( NOUT, FMT = 9997 )S2 - S1 -* - 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / ' End of tests' ) - 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) - 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', - $ I6 ) - 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', - $ I6 ) - 9994 FORMAT( ' Tests of the COMPLEX*16 CHAMELEON routines ', - $ / ' CHAMELEON VERSION ', I1, '.', I1, '.', I1, - $ / / ' The following parameter values will be used:' ) - 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) - 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', - $ 'less than', F8.2, / ) - 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) - 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) - 9989 FORMAT( / 1X, A3, ' routines were not tested' ) - 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) - 9987 FORMAT( ' Invalid input value: ', A6, '=', I6, '; must be 0 or 1') -* -* End of ZCHKAA -* - END diff --git a/testing/lin/zchkge.f b/testing/lin/zchkge.f deleted file mode 100644 index 1e928eccb72efd6b176e2a7272f5bb20655b858f..0000000000000000000000000000000000000000 --- a/testing/lin/zchkge.f +++ /dev/null @@ -1,460 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, - $ IBVAL, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, - $ AINV, B, X, XACT, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ IBVAL( * ), NVAL( * ) - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), - $ WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZCHKGE tests ZGETRF, -TRI, -TRS, -RFS, and -CON. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* IBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the inner block size IB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension -* (max(2*NMAX,2*NSMAX+NWORK)) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL TRFCON, ZEROT - CHARACTER DIST, NORM, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN, - $ IZERO, K, KL, KU, LDA, LWORK, M, MODE, N, NB, - $ NERRS, NFAIL, NIMAT, NRHS, NRUN, NT, IB, - $ CHAMELEON_TRANS - DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY, - $ RCOND, RCONDC, RCONDI, RCONDO - INTEGER HL( 2 ), HPIV( 2 ) -* .. -* .. Local Arrays .. - CHARACTER TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DGET06, ZLANGE - EXTERNAL DGET06, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRGE, ZGECON, - $ ZGERFS, ZGET02, ZGET04, - $ ZGETRF, ZGETRI, ZGETRS, ZLACPY, ZLARHS, ZLASET, - $ ZLATB4, ZLATMS -* .. -* .. Intrinsic Functions .. - INTRINSIC DCMPLX, MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / , -* $ TRANSS / 'N', 'T', 'C' / - $ TRANSS / 'N' / - $ CHAMELEON_TRANSS / CHAMELEONNOTRANS / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - CALL XLAENV( 1, 1 ) - IF( TSTERR ) - $ CALL ZERRGE( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* -* Do for each value of M in MVAL -* - DO 120 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* -* Do for each value of N in NVAL -* - DO 110 IN = 1, NN - N = NVAL( IN ) - XTYPE = 'N' - NIMAT = NTYPES - IF( M.LE.0 .OR. N.LE.0 ) - $ NIMAT = 1 -* - DO 100 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 100 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 100 -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = MIN( M, N ) - ELSE - IZERO = MIN( M, N ) / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, M - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL ZLASET( 'Full', M, N-IZERO+1, DCMPLX( ZERO ), - $ DCMPLX( ZERO ), A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* These lines, if used in place of the calls in the DO 60 -* loop, cause the code to bomb on a Sun SPARCstation. -* -* ANORMO = ZLANGE( 'O', M, N, A, LDA, RWORK ) -* ANORMI = ZLANGE( 'I', M, N, A, LDA, RWORK ) -* -* Do for each blocksize in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IB = IBVAL( INB ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* ALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_ZGETRF_INCPIV( -c$$$ $ M, N, HL, HPIV, INFO ) -* -* Compute the LU factorization of the matrix. -* - CALL ZLACPY( 'Full', M, N, A, LDA, AFAC, LDA ) - SRNAMT = 'ZGETRF' -c$$$ CALL CHAMELEON_ZGETRF_INCPIV( M, N, AFAC, LDA, HL, HPIV, -c$$$ $ INFO ) - CALL CHAMELEON_ZGETRF( M, N, AFAC, LDA, IWORK, - $ INFO ) -* -* Check error code from ZGETRF. -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'ZGETRF', INFO, IZERO, ' ', M, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - TRFCON = .FALSE. - NT = 0 -* - IF( M.NE.N .OR. INFO.GT.0 ) THEN -* -* Do only the condition estimate if INFO > 0. -* - TRFCON = .TRUE. - ANORMO = ZLANGE( 'O', M, N, A, LDA, RWORK ) - ANORMI = ZLANGE( 'I', M, N, A, LDA, RWORK ) - RCONDO = ZERO - RCONDI = ZERO - END IF -* -* Print information about the tests so far that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT -* -* Skip the remaining tests if this is not the first -* block size or if M .ne. N. Skip the solve tests if -* the matrix is singular. -* -* IF( INB.GT.1 .OR. M.NE.N ) -* $ GO TO 90 - IF( TRFCON ) - $ GO TO 70 -* - DO 60 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) - XTYPE = 'N' -* - DO 50 ITRAN = 1, NTRAN - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -*+ TEST 3 -* Solve and compute residual for A * X = B. -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, - $ LDA, ISEED, INFO ) - XTYPE = 'C' -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) - SRNAMT = 'ZGETRS' -c$$$ CALL CHAMELEON_ZGETRS_INCPIV( CHAMELEON_TRANS, N, -c$$$ $ NRHS, AFAC, LDA, HL, HPIV, -c$$$ $ X, LDA, INFO ) - CALL CHAMELEON_ZGETRS( CHAMELEON_TRANS, N, - $ NRHS, AFAC, LDA, IWORK, - $ X, LDA, INFO ) -* -* Check error code from ZGETRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZGETRS', INFO, 0, TRANS, - $ N, N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL ZGET02( TRANS, N, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -* Print information about the tests that did not -* pass the threshold. -* - DO 40 K = 3, 4 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 40 CONTINUE - NRUN = NRUN + 2 - 50 CONTINUE - 60 CONTINUE -* - 70 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE - 100 CONTINUE -* - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M = ', I5, ', N =', I5, ', NB =', I4, ', type ', I2, - $ ', test(', I2, ') =', G12.5 ) - 9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of ZCHKGE -* - END diff --git a/testing/lin/zchklq.f b/testing/lin/zchklq.f deleted file mode 100644 index 02b2e261afab6775b3b4921adce0c6c1e57f986c..0000000000000000000000000000000000000000 --- a/testing/lin/zchklq.f +++ /dev/null @@ -1,415 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AL, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), - $ B( * ), TAU( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZCHKLQ tests ZGELQF, ZUNGLQ and CUNMLQ. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AQ (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AL (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* TAU (workspace) COMPLEX*16 array, dimension (NMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - DOUBLE PRECISION ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL ZGENND - EXTERNAL ZGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, - $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLQT01, - $ ZLQT02, ZLQT03 -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'LQ' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL ZERRLQ( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( N.LT.M ) - $ GO TO 60 - MINMN = MIN( M, N ) - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of ZLQT01; other values are -* used in the calls of ZLQT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGELQF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test ZGELQF -* - CALL ZLQT01( M, N, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.ZGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.LE.N ) THEN -* -* Test ZUNGLQ, using factorization -* returned by ZLQT01 -* - CALL ZLQT02( M, N, K, A, AF, AQ, AL, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - ELSE - RESULT( 1 ) = ZERO - RESULT( 2 ) = ZERO - END IF - IF( M.GE.K ) THEN -* -* Test ZUNMLQ, using factorization returned -* by ZLQT01 -* - CALL ZLQT03( M, N, K, AF, AC, AL, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call ZGELQS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.M .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL ZLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'ZGELQS' - CALL CHAMELEON_ZGELQS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from ZGELQS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZGELQS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL ZGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - ELSE - RESULT( 7 ) = ZERO - END IF - ELSE - RESULT( 3 ) = ZERO - RESULT( 4 ) = ZERO - RESULT( 5 ) = ZERO - RESULT( 6 ) = ZERO - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NT - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', - $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of ZCHKLQ -* - END diff --git a/testing/lin/zchkpo.f b/testing/lin/zchkpo.f deleted file mode 100644 index f5e9d67d76c30975d67c7ac28e634d8e42187fc4..0000000000000000000000000000000000000000 --- a/testing/lin/zchkpo.f +++ /dev/null @@ -1,477 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, - $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, - $ XACT, WORK, RWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER NBVAL( * ), NSVAL( * ), NVAL( * ) - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), - $ WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZCHKPO tests ZPOTRF, -TRI, -TRS, -RFS, and -CON -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NNB (input) INTEGER -* The number of values of NB contained in the vector NBVAL. -* -* NBVAL (input) INTEGER array, dimension (NBVAL) -* The values of the blocksize NB. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AINV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* where NSMAX is the largest entry in NSVAL. -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NSMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension -* (NMAX*max(3,NSMAX)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension -* (NMAX+2*NSMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 CZERO - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 8 ) -* .. -* .. Local Scalars .. - LOGICAL ZEROT - CHARACTER DIST, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO, - $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS, - $ NFAIL, NIMAT, NRHS, NRUN, CHAMELEON_UPLO - DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC -* .. -* .. Local Arrays .. - CHARACTER UPLOS( 2 ) - INTEGER CHAMELEON_UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DGET06, ZLANHE - EXTERNAL DGET06, ZLANHE -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRPO, ZGET04, - $ ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOCON, - $ ZPORFS, ZPOT01, ZPOT02, ZPOT03, ZPOT05, ZPOTRF, - $ ZPOTRI, ZPOTRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL ZERRPO( PATH, NOUT ) - INFOT = 0 -* -* Do for each value of N in NVAL -* - DO 120 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - IZERO = 0 - DO 110 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 110 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 110 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 100 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 100 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = CZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = CZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = CZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = CZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Set the imaginary part of the diagonals. -* - CALL ZLAIPD( N, A, LDA+1, 0 ) -* -* Do for each value of NB in NBVAL -* - DO 90 INB = 1, NNB - NB = NBVAL( INB ) - CALL XLAENV( 1, NB ) - IF ( (N / 25) .GT. NB ) THEN - GOTO 90 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Compute the L*L' or U'*U factorization of the matrix. -* - CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - SRNAMT = 'ZPOTRF' - CALL CHAMELEON_ZPOTRF( CHAMELEON_UPLO, N, AFAC, LDA, INFO ) -* -* Check error code from ZPOTRF. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'ZPOTRF', INFO, IZERO, UPLO, N, - $ N, -1, -1, NB, IMAT, NFAIL, NERRS, - $ NOUT ) - GO TO 90 - END IF -* -* Skip the tests if INFO is not 0. -* - IF( INFO.NE.0 ) - $ GO TO 90 -* -*+ TEST 1 -* Reconstruct matrix from factors and compute residual. -* - CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - CALL ZPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK, - $ RESULT( 1 ) ) -* -*+ TEST 2 -* Form the inverse and compute the residual. -* - CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) - SRNAMT = 'ZPOTRI' - CALL CHAMELEON_ZPOTRI( CHAMELEON_UPLO, N, AINV, LDA, - $ INFO ) -* -* Check error code from ZPOTRI. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZPOTRI', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, - $ RWORK, RCONDC, RESULT( 2 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 60 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + 2 -* -* Skip the rest of the tests unless this is the first -* blocksize. -* - IF( INB.NE.1 ) - $ GO TO 90 -* - DO 80 IRHS = 1, NNS - NRHS = NSVAL( IRHS ) -* -*+ TEST 3 -* Solve and compute residual for A * X = B . -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'ZPOTRS' - CALL CHAMELEON_ZPOTRS( CHAMELEON_UPLO, N, NRHS, AFAC, - $ LDA, X, LDA, INFO ) -* -* Check error code from ZPOTRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZPOTRS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) - CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, - $ LDA, RWORK, RESULT( 3 ) ) -* -*+ TEST 4 -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 4 ) ) -* -*+ TESTS 5, 6, and 7 -* Use iterative refinement to improve the solution. -* - SRNAMT = 'ZPORFS' - CALL ZPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B, - $ LDA, X, LDA, RWORK, RWORK( NRHS+1 ), - $ WORK, RWORK( 2*NRHS+1 ), INFO ) -* -* Check error code from ZPORFS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZPORFS', INFO, 0, UPLO, N, - $ N, -1, -1, NRHS, IMAT, NFAIL, - $ NERRS, NOUT ) -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 5 ) ) - CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, - $ XACT, LDA, RWORK, RWORK( NRHS+1 ), - $ RESULT( 6 ) ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 70 K = 3, 7 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 70 CONTINUE - NRUN = NRUN + 5 - 80 CONTINUE -* -*+ TEST 8 -* Get an estimate of RCOND = 1/CNDNUM. -* - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) - SRNAMT = 'ZPOCON' - CALL ZPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK, - $ RWORK, INFO ) -* -* Check error code from ZPOCON. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZPOCON', INFO, 0, UPLO, N, N, - $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) -* - RESULT( 8 ) = DGET06( RCOND, RCONDC ) -* -* Print the test ratio if it is .GE. THRESH. -* - IF( RESULT( 8 ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8, - $ RESULT( 8 ) - NFAIL = NFAIL + 1 - END IF - NRUN = NRUN + 1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', - $ I2, ', test ', I2, ', ratio =', G12.5 ) - 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', - $ I2, ', test(', I2, ') =', G12.5 ) - 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, - $ ', test(', I2, ') =', G12.5 ) - RETURN -* -* End of ZCHKPO -* - END diff --git a/testing/lin/zchkqr.f b/testing/lin/zchkqr.f deleted file mode 100644 index bb5f4daa26845b5c3f453cbca8291b031812b8dc..0000000000000000000000000000000000000000 --- a/testing/lin/zchkqr.f +++ /dev/null @@ -1,405 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ IBVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, - $ AR, AC, B, X, XACT, TAU, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NMAX, NN, NNB, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), - $ NXVAL( * ), IBVAL( * ) - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( * ), AC( * ), AF( * ), AQ( * ), AR( * ), - $ B( * ), TAU( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZCHKQR tests ZGEQRF, ZUNGQR and CUNMQR. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for M or N, used in dimensioning -* the work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AQ (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AR (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* TAU (workspace) COMPLEX*16 array, dimension (NMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 8 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D0 ) -* .. -* .. Local Scalars .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA, - $ LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK, - $ NRUN, NT, NX, IB, IRH, RHBLK - DOUBLE PRECISION ANORM, CNDNUM -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) - INTEGER HT( 2 ) -* .. -* .. External Functions .. - LOGICAL ZGENND - EXTERNAL ZGENND -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, - $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZQRT01, - $ ZQRT02, ZQRT03 -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - RHBLK = 4 - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'QR' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL ZERRQR( PATH, NOUT ) - INFOT = 0 - CALL XLAENV( 2, 2 ) -* - LDA = NMAX - LWORK = NMAX*MAX( NMAX, NRHS ) -* -* Do for each value of M in MVAL. -* - DO 70 IM = 1, NM - M = MVAL( IM ) -* -* Do for each value of N in NVAL. -* - DO 60 IN = 1, NN - N = NVAL( IN ) - IF ( M.LT.N ) - $ GO TO 60 - MINMN = MIN( M, N ) - DO 50 IMAT = 1, NTYPES -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 50 -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, 'No packing', A, LDA, - $ WORK, INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 50 - END IF -* -* Set some values for K: the first value must be MINMN, -* corresponding to the call of ZQRT01; other values are -* used in the calls of ZQRT02, and must not exceed MINMN. -* - KVAL( 1 ) = MINMN - KVAL( 2 ) = 0 - KVAL( 3 ) = 1 - KVAL( 4 ) = MINMN / 2 - IF( MINMN.EQ.0 ) THEN - NK = 1 - ELSE IF( MINMN.EQ.1 ) THEN - NK = 2 - ELSE IF( MINMN.LE.3 ) THEN - NK = 3 - ELSE - NK = 4 - END IF -* -* Set Householder mode (tree or flat) -* - DO 45 IRH = 0, 1 - IF (IRH .EQ. 0) THEN - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamFlatHouseholder, INFO ) - ELSE - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_MODE, - $ ChamTreeHouseholder, INFO ) - CALL CHAMELEON_SET(CHAMELEON_HOUSEHOLDER_SIZE, - $ RHBLK, INFO) - END IF -* -* Do for each value of K in KVAL -* - DO 40 IK = 1, 2 - K = KVAL( IK ) -* -* Do for each pair of values (NB,NX) in NBVAL and NXVAL. -* - DO 30 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - NX = NXVAL( INB ) - CALL XLAENV( 3, NX ) - IF ( (MAX(M, N) / 10) .GT. NB ) THEN - GOTO 30 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGEQRF( M, N, HT, - $ INFO ) -* - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO - NT = 2 - IF( IK.EQ.1 ) THEN -* -* Test ZGEQRF -* - CALL ZQRT01( M, N, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) -* IF( .NOT.ZGENND( M, N, AF, LDA ) ) -* $ RESULT( 8 ) = 2*THRESH -* NT = NT + 1 - ELSE IF( M.GE.N ) THEN -* -* Test ZUNGQR, using factorization -* returned by ZQRT01 -* - CALL ZQRT02( M, N, K, A, AF, AQ, AR, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 1 ) ) - END IF - IF( M.GE.K ) THEN -* -* Test ZUNMQR, using factorization returned -* by ZQRT01 -* - CALL ZQRT03( M, N, K, AF, AC, AR, AQ, LDA, HT, - $ WORK, LWORK, RWORK, RESULT( 3 ) ) - NT = NT + 4 -* -* If M>=N and K=N, call ZGEQRS to solve a system -* with NRHS right hand sides and compute the -* residual. -* - IF( K.EQ.N .AND. INB.EQ.1 ) THEN -* -* Generate a solution and set the right -* hand side. -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, 'New', 'Full', - $ 'No transpose', M, N, 0, 0, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) -* - CALL ZLACPY( 'Full', M, NRHS, B, LDA, X, - $ LDA ) - SRNAMT = 'ZGEQRS' - CALL CHAMELEON_ZGEQRS( M, N, NRHS, AF, LDA, HT, - $ X, LDA, INFO ) -* -* Check error code from ZGEQRS. -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZGEQRS', INFO, 0, ' ', - $ M, N, NRHS, -1, NB, IMAT, - $ NFAIL, NERRS, NOUT ) -* - CALL ZGET02( 'No transpose', M, N, NRHS, A, - $ LDA, X, LDA, B, LDA, RWORK, - $ RESULT( 7 ) ) - NT = NT + 1 - END IF - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 20 I = 1, NTESTS - IF( RESULT( I ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX, - $ IMAT, I, RESULT( I ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + NT -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 30 CONTINUE - 40 CONTINUE - 45 CONTINUE - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* -* Print a summary of the results. -* - CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=', - $ I5, ', type ', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of ZCHKQR -* - END diff --git a/testing/lin/zdrscl.f b/testing/lin/zdrscl.f deleted file mode 100644 index 3230dea18b58aecb54145ea4634a9172d39ce66c..0000000000000000000000000000000000000000 --- a/testing/lin/zdrscl.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZDRSCL( N, SA, SX, INCX ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INCX, N - DOUBLE PRECISION SA -* .. -* .. Array Arguments .. - COMPLEX*16 SX( * ) -* .. -* -* Purpose -* ======= -* -* ZDRSCL multiplies an n-element complex vector x by the real scalar -* 1/a. This is done without overflow or underflow as long as -* the final result x/a does not overflow or underflow. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of components of the vector x. -* -* SA (input) DOUBLE PRECISION -* The scalar a which is used to divide each component of x. -* SA must be >= 0, or the subroutine will divide by zero. -* -* SX (input/output) COMPLEX*16 array, dimension -* (1+(N-1)*abs(INCX)) -* The n-element vector x. -* -* INCX (input) INTEGER -* The increment between successive values of the vector SX. -* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL DLABAD, ZDSCAL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) -* -* Initialize the denominator to SA and the numerator to 1. -* - CDEN = SA - CNUM = ONE -* - 10 CONTINUE - CDEN1 = CDEN*SMLNUM - CNUM1 = CNUM / BIGNUM - IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN -* -* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. -* - MUL = SMLNUM - DONE = .FALSE. - CDEN = CDEN1 - ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN -* -* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. -* - MUL = BIGNUM - DONE = .FALSE. - CNUM = CNUM1 - ELSE -* -* Multiply X by CNUM / CDEN and return. -* - MUL = CNUM / CDEN - DONE = .TRUE. - END IF -* -* Scale the vector X by MUL -* - CALL ZDSCAL( N, MUL, SX, INCX ) -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of ZDRSCL -* - END diff --git a/testing/lin/zdrvge.f b/testing/lin/zdrvge.f deleted file mode 100644 index bf9c5781e71fa75e3abe05c8528f4393e2c06bd0..0000000000000000000000000000000000000000 --- a/testing/lin/zdrvge.f +++ /dev/null @@ -1,472 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, IWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), NVAL( * ) - DOUBLE PRECISION RWORK( * ), S( * ) - COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZDRVGE tests the driver routines ZGESV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* S (workspace) DOUBLE PRECISION array, dimension (2*NMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (2*NRHS+NMAX) -* -* IWORK (workspace) INTEGER array, dimension (NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 11 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 7 ) - INTEGER NTRAN - PARAMETER ( NTRAN = 1 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT - CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE - CHARACTER*3 PATH - INTEGER HL( 2 ), HPIV( 2 ), IB, CHAMELEON_TRANS - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, - $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, - $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT - DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, - $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, - $ ROLDI, ROLDO, ROWCND, RPVGRW -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_TRANSS( NTRAN) - DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DGET06, DLAMCH, ZLANGE, ZLANTR - EXTERNAL LSAME, DGET06, DLAMCH, ZLANGE, ZLANTR -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGEEQU, - $ ZGESV, ZGESVX, ZGET02, ZGET04, - $ ZGETRF, ZGETRI, ZLACPY, ZLAQGE, ZLARHS, ZLASET, - $ ZLATB4, ZLATMS -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, MAX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* DATA TRANSS / 'N', 'T', 'C' / - DATA TRANSS / 'N' / - DATA CHAMELEON_TRANSS / CHAMELEONNOTRANS / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'R', 'C', 'B' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'GE' - RCONDO = ZERO - RCONDI = ZERO - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL ZERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - IB = 32 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, INFO ) -* -* Do for each value of N in NVAL -* - DO 90 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* -* ALLOCATE L and IPIV -* -c$$$ CALL CHAMELEON_ALLOC_WORKSPACE_ZGETRF_INCPIV( -c$$$ $ N, N, HL, HPIV, INFO ) -* -* - DO 80 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 80 -* -* Skip types 5, 6, or 7 if the matrix size is too small. -* - ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 - IF( ZEROT .AND. N.LT.IMAT-4 ) - $ GO TO 80 -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) - RCONDC = ONE / CNDNUM -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, - $ ANORM, KL, KU, 'No packing', A, LDA, WORK, - $ INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, -1, -1, - $ -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 80 - END IF -* -* For types 5-7, zero one or more columns of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.5 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.6 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA - IF( IMAT.LT.7 ) THEN - DO 20 I = 1, N - A( IOFF+I ) = ZERO - 20 CONTINUE - ELSE - CALL ZLASET( 'Full', N, N-IZERO+1, DCMPLX( ZERO ), - $ DCMPLX( ZERO ), A( IOFF+1 ), LDA ) - END IF - ELSE - IZERO = 0 - END IF -* -* Save a copy of the matrix A in ASAV. -* - CALL ZLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) -* - DO 70 IEQUED = 1, 4 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 60 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 60 - RCONDO = ZERO - RCONDI = ZERO -* - ELSE IF( .NOT.NOFACT ) THEN -* -* Compute the condition number for comparison with -* the value returned by ZGESVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL ZLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL ZGEEQU( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( LSAME( EQUED, 'R' ) ) THEN - ROWCND = ZERO - COLCND = ONE - ELSE IF( LSAME( EQUED, 'C' ) ) THEN - ROWCND = ONE - COLCND = ZERO - ELSE IF( LSAME( EQUED, 'B' ) ) THEN - ROWCND = ZERO - COLCND = ZERO - END IF -* -* Equilibrate the matrix. -* - CALL ZLAQGE( N, N, AFAC, LDA, S, S( N+1 ), - $ ROWCND, COLCND, AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the non-equilibrated -* system for use in ZGET04. -* - IF( EQUIL ) THEN - ROLDO = RCONDO - ROLDI = RCONDI - END IF -* -* Compute the 1-norm and infinity-norm of A. -* - ANORMO = ZLANGE( '1', N, N, AFAC, LDA, RWORK ) - ANORMI = ZLANGE( 'I', N, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* -c$$$ CALL CHAMELEON_ZGETRF_INCPIV( N, N, AFAC, LDA, -c$$$ $ HL, HPIV, INFO ) - CALL CHAMELEON_ZGETRF( N, N, AFAC, LDA, - $ IWORK, INFO ) -* - END IF -* - DO 50 ITRAN = 1, NTRAN -* -* Do for each value of TRANS. -* - TRANS = TRANSS( ITRAN ) - CHAMELEON_TRANS = CHAMELEON_TRANSS( ITRAN ) - IF( ITRAN.EQ.1 ) THEN - RCONDC = RCONDO - ELSE - RCONDC = RCONDI - END IF -* -* Restore the matrix A. -* - CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, - $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT .AND. ITRAN.EQ.1 ) THEN -* -* --- Test ZGESV --- -* -* Compute the LU factorization of the matrix and -* solve the system. -* - CALL ZLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) - CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'ZGESV ' -c$$$ CALL CHAMELEON_ZGESV_INCPIV( N, NRHS, AFAC, LDA, -c$$$ $ HL, HPIV, X, LDA, INFO ) - CALL CHAMELEON_ZGESV( N, NRHS, AFAC, LDA, - $ IWORK, X, LDA, INFO ) -* -* Check error code from ZGESV . -* - IF( INFO.NE.IZERO ) - $ CALL ALAERH( PATH, 'ZGESV ', INFO, IZERO, - $ ' ', N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) -* - IF( IZERO.EQ.0 ) THEN -* -* Compute residual of the computed solution. -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL ZGET02( 'No transpose', N, N, NRHS, A, - $ LDA, X, LDA, WORK, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 2 ) ) - NT = 2 - END IF -* -* Print information about the tests that did not -* pass the threshold. -* - DO 30 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'ZGESV ', N, - $ IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 30 CONTINUE - NRUN = NRUN + NT - END IF -* - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE - 80 CONTINUE -* -* DEALLOCATE HL and HPIV -* -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) -c$$$ CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) - 90 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =', - $ G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', type ', I2, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', - $ G12.5 ) - RETURN -* -* End of ZDRVGE -* - END diff --git a/testing/lin/zdrvls.f b/testing/lin/zdrvls.f deleted file mode 100644 index 71969749566b4c007cbe1daf78cffd6e29c89be5..0000000000000000000000000000000000000000 --- a/testing/lin/zdrvls.f +++ /dev/null @@ -1,402 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, - $ IBVAL, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, - $ B, COPYB, C, S, COPYS, WORK, RWORK, IWORK, - $ NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NM, NN, NNB, NNS, NOUT - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), - $ IBVAL( * ), NVAL( * ), NXVAL( * ) - DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) - COMPLEX*16 A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZDRVLS tests the least squares driver routines ZGELS, CGELSX, CGELSS, -* ZGELSY and CGELSD. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* The matrix of type j is generated as follows: -* j=1: A = U*D*V where U and V are random unitary matrices -* and D has random entries (> 0.1) taken from a uniform -* distribution (0,1). A is full rank. -* j=2: The same of 1, but A is scaled up. -* j=3: The same of 1, but A is scaled down. -* j=4: A = U*D*V where U and V are random unitary matrices -* and D has 3*min(M,N)/4 random entries (> 0.1) taken -* from a uniform distribution (0,1) and the remaining -* entries set to 0. A is rank-deficient. -* j=5: The same of 4, but A is scaled up. -* j=6: The same of 5, but A is scaled down. -* -* NM (input) INTEGER -* The number of values of M contained in the vector MVAL. -* -* MVAL (input) INTEGER array, dimension (NM) -* The values of the matrix row dimension M. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix column dimension N. -* -* NNB (input) INTEGER -* The number of values of NB and NX contained in the -* vectors NBVAL and NXVAL. The blocking parameters are used -* in pairs (NB,NX). -* -* NBVAL (input) INTEGER array, dimension (NNB) -* The values of the blocksize NB. -* -* NXVAL (input) INTEGER array, dimension (NNB) -* The values of the crossover point NX. -* -* NNS (input) INTEGER -* The number of values of NRHS contained in the vector NSVAL. -* -* NSVAL (input) INTEGER array, dimension (NNS) -* The values of the number of right hand sides NRHS. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* A (workspace) COMPLEX*16 array, dimension (MMAX*NMAX) -* where MMAX is the maximum value of M in MVAL and NMAX is the -* maximum value of N in NVAL. -* -* COPYA (workspace) COMPLEX*16 array, dimension (MMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (MMAX*NSMAX) -* where MMAX is the maximum value of M in MVAL and NSMAX is the -* maximum value of NRHS in NSVAL. -* -* COPYB (workspace) COMPLEX*16 array, dimension (MMAX*NSMAX) -* -* C (workspace) COMPLEX*16 array, dimension (MMAX*NSMAX) -* -* S (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* -* WORK (workspace) COMPLEX*16 array, dimension -* (MMAX*NMAX + 4*NMAX + MMAX). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (5*NMAX-1) -* -* IWORK (workspace) INTEGER array, dimension (15*NMAX) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NTESTS - PARAMETER ( NTESTS = 18 ) - INTEGER SMLSIZ - PARAMETER ( SMLSIZ = 25 ) - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - COMPLEX*16 CONE, CZERO - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ), - $ CZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - CHARACTER TRANS - CHARACTER*3 PATH - INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NRHS, NROWS, NRUN, RANK, IB, - $ CHAMELEON_TRANS - INTEGER HT( 2 ) - DOUBLE PRECISION EPS, NORMA, NORMB, RCOND -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, ZQRT14, ZQRT17 - EXTERNAL DASUM, DLAMCH, ZQRT14, ZQRT17 -* .. -* .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASVM, DAXPY, DLASRT, XLAENV, - $ ZDSCAL, ZERRLS, ZGELS, ZGELSD, ZGELSS, ZGELSX, - $ ZGELSY, ZGEMM, ZLACPY, ZLARNV, ZQRT13, ZQRT15, - $ ZQRT16 -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, MIN, SQRT -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, IOUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, IOUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'LS' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE - EPS = DLAMCH( 'Epsilon' ) -* -* Threshold for rank estimation -* - RCOND = SQRT( EPS ) - ( SQRT( EPS )-EPS ) / 2 -* -* Test the error exits -* - CALL XLAENV( 9, SMLSIZ ) - IF( TSTERR ) - $ CALL ZERRLS( PATH, NOUT ) -* -* Print the header if NM = 0 or NN = 0 and THRESH = 0. -* - IF( ( NM.EQ.0 .OR. NN.EQ.0 ) .AND. THRESH.EQ.ZERO ) - $ CALL ALAHD( NOUT, PATH ) - INFOT = 0 -* - DO 140 IM = 1, NM - M = MVAL( IM ) - LDA = MAX( 1, M ) -* - DO 130 IN = 1, NN - N = NVAL( IN ) - MNMIN = MIN( M, N ) - LDB = MAX( 1, M, N ) -* - DO 120 INS = 1, NNS - NRHS = NSVAL( INS ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 2*N+M ) -* - DO 110 IRANK = 1, 2 - DO 100 ISCALE = 1, 3 - ITYPE = ( IRANK-1 )*3 + ISCALE - IF( .NOT.DOTYPE( ITYPE ) ) - $ GO TO 100 -* - IF( IRANK.EQ.1 ) THEN -* -* Test ZGELS -* -* Generate a matrix of scaling type ISCALE -* - CALL ZQRT13( ISCALE, M, N, COPYA, LDA, NORMA, - $ ISEED ) - DO 40 INB = 1, NNB - NB = NBVAL( INB ) - IB = IBVAL( INB ) - CALL XLAENV( 1, NB ) - CALL XLAENV( 3, NXVAL( INB ) ) - IF ( (MAX(M, N) / 25) .GT. NB ) THEN - GOTO 40 - END IF - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) - CALL CHAMELEON_SET( CHAMELEON_INNER_BLOCK_SIZE, IB, - $ INFO ) -* -* Allocate T -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGELS( M, N , HT, - $ INFO ) -* -* DO 30 ITRAN = 1, 2 - DO 30 ITRAN = 1, 1 - IF( ITRAN.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - NROWS = M - NCOLS = N - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - NROWS = N - NCOLS = M - END IF - LDWORK = MAX( 1, NCOLS ) -* -* Set up a consistent rhs -* - IF( NCOLS.GT.0 ) THEN - CALL ZLARNV( 2, ISEED, NCOLS*NRHS, - $ WORK ) - CALL ZDSCAL( NCOLS*NRHS, - $ ONE / DBLE( NCOLS ), WORK, - $ 1 ) - END IF - CALL ZGEMM( TRANS, 'No transpose', NROWS, - $ NRHS, NCOLS, CONE, COPYA, LDA, - $ WORK, LDWORK, CZERO, B, LDB ) - CALL ZLACPY( 'Full', NROWS, NRHS, B, LDB, - $ COPYB, LDB ) -* -* Solve LS or overdetermined system -* - IF( M.GT.0 .AND. N.GT.0 ) THEN - CALL ZLACPY( 'Full', M, N, COPYA, LDA, - $ A, LDA ) - CALL ZLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, B, LDB ) - END IF - SRNAMT = 'ZGELS ' - CALL CHAMELEON_ZGELS( CHAMELEON_TRANS, - $ M, N, NRHS, - $ A, LDA, HT, B, LDB, - $ INFO ) -* - IF( INFO.NE.0 ) - $ CALL ALAERH( PATH, 'ZGELS ', INFO, 0, - $ TRANS, M, N, NRHS, -1, NB, - $ ITYPE, NFAIL, NERRS, - $ NOUT ) -* -* Check correctness of results -* - LDWORK = MAX( 1, NROWS ) - IF( NROWS.GT.0 .AND. NRHS.GT.0 ) - $ CALL ZLACPY( 'Full', NROWS, NRHS, - $ COPYB, LDB, C, LDB ) - CALL ZQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, RWORK, - $ RESULT( 1 ) ) -* - IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. - $ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN -* -* Solving LS system -* - RESULT( 2 ) = ZQRT17( TRANS, 1, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ COPYB, LDB, C, WORK, - $ LWORK ) - ELSE -* -* Solving overdetermined system -* - RESULT( 2 ) = ZQRT14( TRANS, M, N, - $ NRHS, COPYA, LDA, B, LDB, - $ WORK, LWORK ) - END IF -* -* Print information about the tests that -* did not pass the threshold. -* - DO 20 K = 1, 2 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )TRANS, M, - $ N, NRHS, NB, ITYPE, K, - $ RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 20 CONTINUE - NRUN = NRUN + 2 - 30 CONTINUE -* -* Deallocate T -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - 40 CONTINUE - END IF -* - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) - 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, - $ ', type', I2, ', test(', I2, ')=', G12.5 ) - RETURN -* -* End of ZDRVLS -* - END diff --git a/testing/lin/zdrvpo.f b/testing/lin/zdrvpo.f deleted file mode 100644 index 89792a4f4f8ece427f119a1c6b6d84251a56b627..0000000000000000000000000000000000000000 --- a/testing/lin/zdrvpo.f +++ /dev/null @@ -1,567 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, - $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, - $ RWORK, NOUT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL TSTERR - INTEGER NMAX, NN, NOUT, NRHS - DOUBLE PRECISION THRESH -* .. -* .. Array Arguments .. - LOGICAL DOTYPE( * ) - INTEGER NVAL( * ) - DOUBLE PRECISION RWORK( * ), S( * ) - COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), - $ BSAV( * ), WORK( * ), X( * ), XACT( * ) -* .. -* -* Purpose -* ======= -* -* ZDRVPO tests the driver routines ZPOSV and -SVX. -* -* Arguments -* ========= -* -* DOTYPE (input) LOGICAL array, dimension (NTYPES) -* The matrix types to be used for testing. Matrices of type j -* (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = -* .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. -* -* NN (input) INTEGER -* The number of values of N contained in the vector NVAL. -* -* NVAL (input) INTEGER array, dimension (NN) -* The values of the matrix dimension N. -* -* NRHS (input) INTEGER -* The number of right hand side vectors to be generated for -* each linear system. -* -* THRESH (input) DOUBLE PRECISION -* The threshold value for the test ratios. A result is -* included in the output file if RESULT >= THRESH. To have -* every test ratio printed, use THRESH = 0. -* -* TSTERR (input) LOGICAL -* Flag that indicates whether error exits are to be tested. -* -* NMAX (input) INTEGER -* The maximum value permitted for N, used in dimensioning the -* work arrays. -* -* A (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* AFAC (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* ASAV (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) -* -* B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* BSAV (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) -* -* S (workspace) DOUBLE PRECISION array, dimension (NMAX) -* -* WORK (workspace) COMPLEX*16 array, dimension -* (NMAX*max(3,NRHS)) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS) -* -* NOUT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER NTYPES - PARAMETER ( NTYPES = 9 ) - INTEGER NTESTS - PARAMETER ( NTESTS = 6 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, PREFAC, ZEROT - CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, - $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, - $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, - $ CHAMELEON_UPLO - DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, - $ ROLDC, SCOND -* .. -* .. Local Arrays .. - CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) - INTEGER ISEED( 4 ), ISEEDY( 4 ), CHAMELEON_UPLOS( 2 ) - DOUBLE PRECISION RESULT( NTESTS ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DGET06, ZLANHE - EXTERNAL LSAME, DGET06, ZLANHE -* .. -* .. External Subroutines .. - EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, - $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4, - $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02, - $ ZPOT05, ZPOTRF, ZPOTRI -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NUNIT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NUNIT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DCMPLX, MAX -* .. -* .. Data statements .. - DATA ISEEDY / 1988, 1989, 1990, 1991 / - DATA UPLOS / 'U', 'L' / - DATA CHAMELEON_UPLOS / CHAMELEONUPPER, CHAMELEONLOWER / - DATA FACTS / 'F', 'N', 'E' / - DATA EQUEDS / 'N', 'Y' / -* .. -* .. Executable Statements .. -* -* Initialize constants and the random number seed. -* - PATH( 1: 1 ) = 'Zomplex precision' - PATH( 2: 3 ) = 'PO' - NRUN = 0 - NFAIL = 0 - NERRS = 0 - DO 10 I = 1, 4 - ISEED( I ) = ISEEDY( I ) - 10 CONTINUE -* -* Test the error exits -* - IF( TSTERR ) - $ CALL ZERRVX( PATH, NOUT ) - INFOT = 0 -* -* Set the block size and minimum block size for testing. -* - NB = 128 - NBMIN = 32 - CALL XLAENV( 1, NB ) - CALL XLAENV( 2, NBMIN ) - CALL CHAMELEON_SET( CHAMELEON_TILE_SIZE, NB, INFO ) -* -* Do for each value of N in NVAL -* - DO 130 IN = 1, NN - N = NVAL( IN ) - LDA = MAX( N, 1 ) - XTYPE = 'N' - NIMAT = NTYPES - IF( N.LE.0 ) - $ NIMAT = 1 -* - DO 120 IMAT = 1, NIMAT -* -* Do the tests only if DOTYPE( IMAT ) is true. -* - IF( .NOT.DOTYPE( IMAT ) ) - $ GO TO 120 -* -* Skip types 3, 4, or 5 if the matrix size is too small. -* - ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 - IF( ZEROT .AND. N.LT.IMAT-2 ) - $ GO TO 120 -* -* Do first for UPLO = 'U', then for UPLO = 'L' -* - DO 110 IUPLO = 1, 2 - UPLO = UPLOS( IUPLO ) - CHAMELEON_UPLO = CHAMELEON_UPLOS( IUPLO ) -* -* Set up parameters with ZLATB4 and generate a test matrix -* with ZLATMS. -* - CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* - SRNAMT = 'ZLATMS' - CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, - $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, - $ INFO ) -* -* Check error code from ZLATMS. -* - IF( INFO.NE.0 ) THEN - CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, - $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) - GO TO 110 - END IF -* -* For types 3-5, zero one row and column of the matrix to -* test that INFO is returned correctly. -* - IF( ZEROT ) THEN - IF( IMAT.EQ.3 ) THEN - IZERO = 1 - ELSE IF( IMAT.EQ.4 ) THEN - IZERO = N - ELSE - IZERO = N / 2 + 1 - END IF - IOFF = ( IZERO-1 )*LDA -* -* Set row and column IZERO of A to 0. -* - IF( IUPLO.EQ.1 ) THEN - DO 20 I = 1, IZERO - 1 - A( IOFF+I ) = ZERO - 20 CONTINUE - IOFF = IOFF + IZERO - DO 30 I = IZERO, N - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 30 CONTINUE - ELSE - IOFF = IZERO - DO 40 I = 1, IZERO - 1 - A( IOFF ) = ZERO - IOFF = IOFF + LDA - 40 CONTINUE - IOFF = IOFF - IZERO - DO 50 I = IZERO, N - A( IOFF+I ) = ZERO - 50 CONTINUE - END IF - ELSE - IZERO = 0 - END IF -* -* Set the imaginary part of the diagonals. -* - CALL ZLAIPD( N, A, LDA+1, 0 ) -* -* Save a copy of the matrix A in ASAV. -* - CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) -* - DO 100 IEQUED = 1, 2 - EQUED = EQUEDS( IEQUED ) - IF( IEQUED.EQ.1 ) THEN - NFACT = 3 - ELSE - NFACT = 1 - END IF -* - DO 90 IFACT = 1, NFACT - FACT = FACTS( IFACT ) - PREFAC = LSAME( FACT, 'F' ) - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) -* - IF( ZEROT ) THEN - IF( PREFAC ) - $ GO TO 90 - RCONDC = ZERO -* - ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN -* -* Compute the condition number for comparison with -* the value returned by ZPOSVX (FACT = 'N' reuses -* the condition number from the previous iteration -* with FACT = 'F'). -* - CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) - IF( EQUIL .OR. IEQUED.GT.1 ) THEN -* -* Compute row and column scale factors to -* equilibrate the matrix A. -* - CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX, - $ INFO ) - IF( INFO.EQ.0 .AND. N.GT.0 ) THEN - IF( IEQUED.GT.1 ) - $ SCOND = ZERO -* -* Equilibrate the matrix. -* - CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND, - $ AMAX, EQUED ) - END IF - END IF -* -* Save the condition number of the -* non-equilibrated system for use in ZGET04. -* - IF( EQUIL ) - $ ROLDC = RCONDC -* -* Compute the 1-norm of A. -* - ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK ) -* -* Factor the matrix A. -* - CALL CHAMELEON_ZPOTRF( CHAMELEON_UPLO, N, - $ AFAC, LDA, INFO ) -* -* Form the inverse of A. -* - CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) - CALL CHAMELEON_ZPOTRI( CHAMELEON_UPLO, N, A, LDA, - $ INFO ) -* -* Compute the 1-norm condition number of A. -* - AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCONDC = ONE - ELSE - RCONDC = ( ONE / ANORM ) / AINVNM - END IF - END IF -* -* Restore the matrix A. -* - CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) -* -* Form an exact solution and set the right hand side. -* - SRNAMT = 'ZLARHS' - CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, - $ NRHS, A, LDA, XACT, LDA, B, LDA, - $ ISEED, INFO ) - XTYPE = 'C' - CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) -* - IF( NOFACT ) THEN -* -* --- Test ZPOSV --- -* -* Compute the L*L' or U'*U factorization of the -* matrix and solve the system. -* - CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) - CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) -* - SRNAMT = 'ZPOSV ' - CALL CHAMELEON_ZPOSV( CHAMELEON_UPLO, N, NRHS, - $ AFAC, LDA, X, LDA, INFO ) -* -* Check error code from ZPOSV . -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO, - $ UPLO, N, N, -1, -1, NRHS, IMAT, - $ NFAIL, NERRS, NOUT ) - GO TO 70 - ELSE IF( INFO.NE.0 ) THEN - GO TO 70 - END IF -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, - $ RESULT( 1 ) ) -* -* Compute residual of the computed solution. -* - CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, - $ LDA ) - CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, - $ WORK, LDA, RWORK, RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, - $ RESULT( 3 ) ) - NT = 3 -* -* Print information about the tests that did not -* pass the threshold. -* - DO 60 K = 1, NT - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO, - $ N, IMAT, K, RESULT( K ) - NFAIL = NFAIL + 1 - END IF - 60 CONTINUE - NRUN = NRUN + NT - 70 CONTINUE - END IF -* -* --- Test ZPOSVX --- -* - IF( .NOT.PREFAC ) - $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), - $ DCMPLX( ZERO ), AFAC, LDA ) - CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), - $ DCMPLX( ZERO ), X, LDA ) - IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN -* -* Equilibrate the matrix if FACT='F' and -* EQUED='Y'. -* - CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, - $ EQUED ) - END IF -* -* Solve the system and compute the condition number -* and error bounds using ZPOSVX. -* - SRNAMT = 'ZPOSVX' - CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, - $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, - $ RWORK, RWORK( NRHS+1 ), WORK, - $ RWORK( 2*NRHS+1 ), INFO ) -* -* Check the error code from ZPOSVX. -* - IF( INFO.NE.IZERO ) THEN - CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO, - $ FACT // UPLO, N, N, -1, -1, NRHS, - $ IMAT, NFAIL, NERRS, NOUT ) - GO TO 90 - END IF -* - IF( INFO.EQ.0 ) THEN - IF( .NOT.PREFAC ) THEN -* -* Reconstruct matrix from factors and compute -* residual. -* - CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, - $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) - K1 = 1 - ELSE - K1 = 2 - END IF -* -* Compute residual of the computed solution. -* - CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, - $ LDA ) - CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, - $ WORK, LDA, RWORK( 2*NRHS+1 ), - $ RESULT( 2 ) ) -* -* Check solution from generated exact solution. -* - IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, - $ 'N' ) ) ) THEN - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, - $ RCONDC, RESULT( 3 ) ) - ELSE - CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, - $ ROLDC, RESULT( 3 ) ) - END IF -* -* Check the error bounds from iterative -* refinement. -* - CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, - $ X, LDA, XACT, LDA, RWORK, - $ RWORK( NRHS+1 ), RESULT( 4 ) ) - ELSE - K1 = 6 - END IF -* -* Compare RCOND from ZPOSVX with the computed value -* in RCONDC. -* - RESULT( 6 ) = DGET06( RCOND, RCONDC ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO 80 K = K1, 6 - IF( RESULT( K ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALADHD( NOUT, PATH ) - IF( PREFAC ) THEN - WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT, - $ UPLO, N, EQUED, IMAT, K, RESULT( K ) - ELSE - WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT, - $ UPLO, N, IMAT, K, RESULT( K ) - END IF - NFAIL = NFAIL + 1 - END IF - 80 CONTINUE - NRUN = NRUN + 7 - K1 - 90 CONTINUE - 100 CONTINUE - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* -* Print a summary of the results. -* - CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) -* - 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, - $ ', test(', I1, ')=', G12.5 ) - 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', type ', I1, ', test(', I1, ')=', G12.5 ) - 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, - $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', - $ G12.5 ) - RETURN -* -* End of ZDRVPO -* - END diff --git a/testing/lin/zerrge.f b/testing/lin/zerrge.f deleted file mode 100644 index fc1b5e180c927168635b6857ab54d1f0288605b0..0000000000000000000000000000000000000000 --- a/testing/lin/zerrge.f +++ /dev/null @@ -1,242 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRGE( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRGE tests the error exits for the COMPLEX*16 routines -* for general matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION ANRM, CCOND, RCOND -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - INTEGER HL( 2 ), HPIV( 2 ) - DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) - COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZGBCON, ZGBEQU, ZGBRFS, ZGBTF2, - $ ZGBTRF, ZGBTRS, ZGECON, ZGEEQU, ZGERFS, ZGETF2, - $ ZGETRF, ZGETRI, ZGETRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - IP( J ) = J - 20 CONTINUE - OK = .TRUE. -* -* Test error exits of the routines that use the LU decomposition -* of a general matrix. -* - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ZGETRF -* -* -* ALLOCATE L and IPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* ZGETRF -* - SRNAMT = 'ZGETRF' - INFOT = 1 - CALL CHAMELEON_ZGETRF_INCPIV( -1, 0, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGETRF_INCPIV( 0, -1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGETRF_INCPIV( 2, 1, A, 1, HL, HPIV, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) -* -* ZGETRS -* - SRNAMT = 'ZGETRS' - INFOT = 103 - CALL CHAMELEON_ZGETRS_INCPIV( '/', -1, 0, A, 1, HL, HPIV, - $ B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGETRS_INCPIV( CHAMELEONNOTRANS, -1, 0, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZGETRS_INCPIV( CHAMELEONNOTRANS, 0, -1, A, 1, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 1, HL, - $ HPIV, B, 2, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_ZGETRS_INCPIV( CHAMELEONNOTRANS, 2, 1, A, 2, HL, - $ HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE L and IPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* LAPACK Interface -* ZGETRF -* - SRNAMT = 'ZGETRF' - INFOT = 1 - CALL CHAMELEON_ZGETRF( -1, 0, A, 1, IP, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGETRF( 0, -1, A, 1, IP, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGETRF( 2, 1, A, 1, IP, INFO ) - CALL CHKXER( 'ZGETRF', INFOT, NOUT, INFO, OK ) -* -* ZGETRS -* - SRNAMT = 'ZGETRS' - INFOT = 1 - CALL CHAMELEON_ZGETRS( '/', 0, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGETRS( CHAMELEONNOTRANS, -1, 0, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZGETRS( CHAMELEONNOTRANS, 0, -1, A, 1, IP, - $ B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZGETRS( CHAMELEONNOTRANS, 2, 1, A, 1, IP, - $ B, 2, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_ZGETRS( CHAMELEONNOTRANS, 2, 1, A, 2, IP, - $ B, 1, INFO ) - CALL CHKXER( 'ZGETRS', INFOT, NOUT, INFO, OK ) -* - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRGE -* - END diff --git a/testing/lin/zerrlq.f b/testing/lin/zerrlq.f deleted file mode 100644 index a58b69a086e8532f64dc9416e6e350d3477d6501..0000000000000000000000000000000000000000 --- a/testing/lin/zerrlq.f +++ /dev/null @@ -1,255 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRLQ( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRLQ tests the error exits for the COMPLEX*16 routines -* that use the LQ decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZGELQ2, ZGELQF, ZUNGL2, - $ ZUNGLQ, ZUNML2, ZUNMLQ -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - 10 CONTINUE - B( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - 20 CONTINUE - OK = .TRUE. -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGELQF( 2, 2, HT, INFO ) -* -* Error exits for LQ factorization -* -* ZGELQF -* - SRNAMT = 'ZGELQF' - INFOT = 1 - CALL CHAMELEON_ZGELQF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'ZGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGELQF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'ZGELQF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGELQF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'ZGELQF', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_ZGELQS -* - SRNAMT = 'ZGELQS' - INFOT = 1 - CALL CHAMELEON_ZGELQS( -1, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGELQS( 0, -1, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGELQS( 2, 1, 0, A, 2, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZGELQS( 0, 0, -1, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZGELQS( 2, 2, 0, A, 1, HT, B, 2, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_ZGELQS( 1, 2, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELQS', INFOT, NOUT, INFO, OK ) -* -* ZUNGLQ -* - SRNAMT = 'ZUNGLQ' - INFOT = 1 - CALL CHAMELEON_ZUNGLQ( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNGLQ( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNGLQ( 2, 1, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNGLQ( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNGLQ( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZUNGLQ( 2, 2, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_ZUNGLQ( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGLQ', INFOT, NOUT, INFO, OK ) -* -* ZUNMLQ -* - SRNAMT = 'ZUNMLQ' - INFOT = 1 - CALL CHAMELEON_ZUNMLQ( '/', CHAMELEONCONJTRANS, 0, 0, 0, A, 1, X, AF, 1, - $ INFO ) - CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, X, AF, 1, - $ INFO ) - CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, -1, 0, 0, A, 1, - $ X, AF, 1, INFO ) - CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, -1, 0, A, 1, - $ X, AF, 1, INFO ) - CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 0, -1, A, 1, - $ X, AF, 1, INFO ) - CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 1, 1, A, 1, X, AF, 1, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 1, 0, 1, A, 1, X, AF, 1, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 0, 2, A, 1, X, AF, 2, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 0, 2, 2, A, 1, X, AF, 1, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 2, X, AF, 1, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, X, AF, 1, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* INFOT = 12 -* CALL CHAMELEON_ZUNMLQ( CHAMELEONRIGHT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, X, AF, 2, INFO ) -* CALL CHKXER( 'ZUNMLQ', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRLQ -* - END diff --git a/testing/lin/zerrls.f b/testing/lin/zerrls.f deleted file mode 100644 index d3041818a7353ea4606d9950289ff23b1169f6d0..0000000000000000000000000000000000000000 --- a/testing/lin/zerrls.f +++ /dev/null @@ -1,165 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRLS( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRLS tests the error exits for the COMPLEX*16 least squares -* driver routines (ZGELS, ZGELSS, CGELSX, CGELSY, CGELSD). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER INFO, IRNK - DOUBLE PRECISION RCOND - INTEGER HT( 2 ) -* .. -* .. Local Arrays .. - INTEGER IP( NMAX ) - DOUBLE PRECISION RW( NMAX ), S( NMAX ) - COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZGELS, ZGELSD, ZGELSS, ZGELSX, - $ ZGELSY -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - C2 = PATH( 2: 3 ) - A( 1, 1 ) = ( 1.0D+0, 0.0D+0 ) - A( 1, 2 ) = ( 2.0D+0, 0.0D+0 ) - A( 2, 2 ) = ( 3.0D+0, 0.0D+0 ) - A( 2, 1 ) = ( 4.0D+0, 0.0D+0 ) - OK = .TRUE. - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Test error exits for the least squares driver routines. -* - IF( LSAMEN( 2, C2, 'LS' ) ) THEN -* -* ZGELS -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGELS( 2, 2, HT, INFO ) -* - SRNAMT = 'ZGELS ' - INFOT = 103 - CALL CHAMELEON_ZGELS( '/', 0, 0, 0, A, 1, HT, B, 1, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGELS( CHAMELEONNOTRANS, -1, 0, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZGELS( CHAMELEONNOTRANS, 0, -1, 0, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGELS( CHAMELEONNOTRANS, 0, 0, -1, A, 1, HT, - $ B, 1, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL CHAMELEON_ZGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 1, HT, - $ B, 2, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) - INFOT = 9 - CALL CHAMELEON_ZGELS( CHAMELEONNOTRANS, 2, 0, 0, A, 2, HT, - $ B, 1, INFO ) - CALL CHKXER( 'ZGELS ', INFOT, NOUT, INFO, OK ) -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRLS -* - END diff --git a/testing/lin/zerrpo.f b/testing/lin/zerrpo.f deleted file mode 100644 index 0c5269c7c5df44998c394876c3819b9716a2b813..0000000000000000000000000000000000000000 --- a/testing/lin/zerrpo.f +++ /dev/null @@ -1,183 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRPO( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRPO tests the error exits for the COMPLEX*16 routines -* for Hermitian positive definite matrices. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION ANRM, RCOND -* .. -* .. Local Arrays .. - DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) - COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZPBCON, ZPBEQU, ZPBRFS, ZPBTF2, - $ ZPBTRF, ZPBTRS, ZPOCON, ZPOEQU, ZPORFS, ZPOTF2, - $ ZPOTRF, ZPOTRI, ZPOTRS, ZPPCON, ZPPEQU, ZPPRFS, - $ ZPPTRF, ZPPTRI, ZPPTRS -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - 20 CONTINUE - ANRM = 1.D0 - OK = .TRUE. -* -* Test error exits of the routines that use the Cholesky -* decomposition of a Hermitian positive definite matrix. -* - IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* ZPOTRF -* - SRNAMT = 'ZPOTRF' - INFOT = 1 - CALL CHAMELEON_ZPOTRF( '/', 0, A, 1, INFO ) - CALL CHKXER( 'ZPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZPOTRF( CHAMELEONUPPER, -1, A, 1, INFO ) - CALL CHKXER( 'ZPOTRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZPOTRF( CHAMELEONUPPER, 2, A, 1, INFO ) - CALL CHKXER( 'ZPOTRF', INFOT, NOUT, INFO, OK ) -* -* ZPOTRS -* - SRNAMT = 'ZPOTRS' - INFOT = 1 - CALL CHAMELEON_ZPOTRS( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZPOTRS( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZPOTRS( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZPOTRS( CHAMELEONUPPER, 2, 1, A, 1, B, 2, INFO ) - CALL CHKXER( 'ZPOTRS', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_ZPOTRS( CHAMELEONUPPER, 2, 1, A, 2, B, 1, INFO ) - END IF -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRPO -* - END diff --git a/testing/lin/zerrqr.f b/testing/lin/zerrqr.f deleted file mode 100644 index fd867c33dde97f873292d5962fe038ec0b38001d..0000000000000000000000000000000000000000 --- a/testing/lin/zerrqr.f +++ /dev/null @@ -1,253 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRQR( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRQR tests the error exits for the COMPLEX*16 routines -* that use the QR decomposition of a general matrix. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 2 ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, J -* .. -* .. Local Arrays .. - COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( NMAX ), X( NMAX ) - INTEGER HT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL ALAESM, CHKXER, ZGEQR2, ZGEQRF, ZUNG2R, - $ ZUNGQR, ZUNM2R, ZUNMQR -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - 10 CONTINUE - B( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - 20 CONTINUE - OK = .TRUE. -* -* Allocate HT -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGEQRF( 2, 2, HT, INFO ) -* -* -* Error exits for QR factorization -* -* ZGEQRF -* - SRNAMT = 'ZGEQRF' - INFOT = 1 - CALL CHAMELEON_ZGEQRF( -1, 0, A, 1, HT, INFO ) - CALL CHKXER( 'ZGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGEQRF( 0, -1, A, 1, HT, INFO ) - CALL CHKXER( 'ZGEQRF', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGEQRF( 2, 1, A, 1, HT, INFO ) - CALL CHKXER( 'ZGEQRF', INFOT, NOUT, INFO, OK ) -* -* ZGEQRS -* - SRNAMT = 'ZGEQRS' - INFOT = 1 - CALL CHAMELEON_ZGEQRS( -1, 0, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGEQRS( 0, -1, 0, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGEQRS( 1, 2, 0, A, 2, X, B, 2, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZGEQRS( 0, 0, -1, A, 1, X, B, 1, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZGEQRS( 2, 1, 0, A, 1, X, B, 2, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_ZGEQRS( 2, 1, 0, A, 2, X, B, 1, INFO ) - CALL CHKXER( 'ZGEQRS', INFOT, NOUT, INFO, OK ) -* -* ZUNGQR -* - SRNAMT = 'ZUNGQR' - INFOT = 1 - CALL CHAMELEON_ZUNGQR( -1, 0, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNGQR( 0, -1, 0, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNGQR( 1, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNGQR( 0, 0, -1, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNGQR( 1, 1, 2, A, 1, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZUNGQR( 2, 2, 0, A, 1, HT, W, 2, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_ZUNGQR( 2, 2, 0, A, 2, HT, W, 1, INFO ) - CALL CHKXER( 'ZUNGQR', INFOT, NOUT, INFO, OK ) -* -* CHAMELEON_ZUNMQR -* - SRNAMT = 'ZUNMQR' - INFOT = 1 - CALL CHAMELEON_ZUNMQR( '/', CHAMELEONCONJTRANS, 0, 0, 0, A, 1, HT, AF, - $ 1, INFO ) - CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, '/', 0, 0, 0, A, 1, HT, AF, 1, - $ INFO ) - CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, -1, 0, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, -1, 0, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 0, -1, A, 1, - $ HT, AF, 1, INFO ) - CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 0, 1, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 5 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 0, 1, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 7 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 1, 2, 0, A, 1, HT, -* 4 AF, 1, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* INFOT = 10 -* CALL CHAMELEON_ZUNMQR( CHAMELEONLEFT, CHAMELEONCONJTRANS, 2, 1, 0, A, 1, HT, -* 4 AF, 2, INFO ) -* CALL CHKXER( 'ZUNMQR', INFOT, NOUT, INFO, OK ) -* -* Print a summary line. -* - CALL ALAESM( PATH, OK, NOUT ) -* -* Deallocate HT -* - CALL CHAMELEON_DEALLOC_HANDLE( HT, INFO ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRQR -* - END diff --git a/testing/lin/zerrvx.f b/testing/lin/zerrvx.f deleted file mode 100644 index 06e0ed293a7452c26ae04bda4250b472c071759f..0000000000000000000000000000000000000000 --- a/testing/lin/zerrvx.f +++ /dev/null @@ -1,271 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZERRVX( PATH, NUNIT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* January 2007 -* -* .. Scalar Arguments .. - CHARACTER*3 PATH - INTEGER NUNIT -* .. -* -* Purpose -* ======= -* -* ZERRVX tests the error exits for the COMPLEX*16 driver routines -* for solving linear systems of equations. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name for the routines to be tested. -* -* NUNIT (input) INTEGER -* The unit number for output. -* -* ===================================================================== -* -* .. Parameters .. - INTEGER NMAX - PARAMETER ( NMAX = 4 ) -* .. -* .. Local Scalars .. - CHARACTER EQ - CHARACTER*2 C2 - INTEGER I, INFO, J - DOUBLE PRECISION RCOND -* .. -* .. Local Arrays .. - INTEGER HL( 2 ), HPIV( 2 ) - INTEGER IP( NMAX ) - DOUBLE PRECISION C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ), - $ RF( NMAX ), RW( NMAX ) - COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), - $ W( 2*NMAX ), X( NMAX ), IW( NMAX ) -* .. -* .. External Functions .. - LOGICAL LSAMEN - EXTERNAL LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL CHKXER, ZGBSV, ZGBSVX, ZGESV, ZGESVX, ZGTSV, - $ ZGTSVX, ZHESV, ZHESVX, ZHPSV, ZHPSVX, ZPBSV, - $ ZPBSVX, ZPOSV, ZPOSVX, ZPPSV, ZPPSVX, ZPTSV, - $ ZPTSVX, ZSPSV, ZSPSVX, ZSYSV, ZSYSVX -* .. -* .. Scalars in Common .. - LOGICAL LERR, OK - CHARACTER*32 SRNAMT - INTEGER INFOT, NOUT -* .. -* .. Common blocks .. - COMMON / INFOC / INFOT, NOUT, OK, LERR - COMMON / SRNAMC / SRNAMT -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - NOUT = NUNIT - WRITE( NOUT, FMT = * ) - C2 = PATH( 2: 3 ) -* -* Disable CHAMELEON warnings/errors -* - CALL CHAMELEON_DISABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_DISABLE( CHAMELEON_ERRORS, INFO ) -* -* Set the variables to innocuous values. -* - DO 20 J = 1, NMAX - DO 10 I = 1, NMAX - A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), - $ -1.D0 / DBLE( I+J ) ) - 10 CONTINUE - B( J ) = 0.D0 - R1( J ) = 0.D0 - R2( J ) = 0.D0 - W( J ) = 0.D0 - X( J ) = 0.D0 - C( J ) = 0.D0 - R( J ) = 0.D0 - IP( J ) = J - 20 CONTINUE - EQ = ' ' - OK = .TRUE. - IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* ALLOCATE HL and HPIV -* - CALL CHAMELEON_ALLOC_WORKSPACE_ZGETRF_INCPIV( - $ 2, 1, HL, HPIV, INFO ) -* -* -* ZGESV -* - SRNAMT = 'ZGESV ' - INFOT = 1 - CALL CHAMELEON_ZGESV_INCPIV( -1, 0, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGESV_INCPIV( 0, -1, A, 1, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGESV_INCPIV( 2, 1, A, 1, HL, HPIV, B, 2, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL CHAMELEON_ZGESV_INCPIV( 2, 1, A, 2, HL, HPIV, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) -* -* DEALLOCATE HL and HPIV -* - CALL CHAMELEON_DEALLOC_HANDLE( HL, INFO ) - CALL CHAMELEON_DEALLOC_HANDLE( HPIV, INFO ) -* -* -* ZGESV -* - SRNAMT = 'ZGESV ' - INFOT = 1 - CALL CHAMELEON_ZGESV( -1, 0, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZGESV( 0, -1, A, 1, IWORK, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL CHAMELEON_ZGESV( 2, 1, A, 1, IWORK, B, 2, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_ZGESV( 2, 1, A, 2, IWORK, B, 1, INFO ) - CALL CHKXER( 'ZGESV ', INFOT, NOUT, INFO, OK ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN -* -* ZPOSV -* - SRNAMT = 'ZPOSV ' - INFOT = 1 - CALL CHAMELEON_ZPOSV( '/', 0, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL CHAMELEON_ZPOSV( CHAMELEONUPPER, -1, 0, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL CHAMELEON_ZPOSV( CHAMELEONUPPER, 0, -1, A, 1, B, 1, INFO ) - CALL CHKXER( 'ZPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 5 - CALL CHAMELEON_ZPOSV( CHAMELEONUPPER, 2, 0, A, 1, B, 2, INFO ) - CALL CHKXER( 'ZPOSV ', INFOT, NOUT, INFO, OK ) - INFOT = 7 - CALL CHAMELEON_ZPOSV( CHAMELEONUPPER, 2, 0, A, 2, B, 1, INFO ) - CALL CHKXER( 'ZPOSV ', INFOT, NOUT, INFO, OK ) -* -* ZPOSVX -* - SRNAMT = 'ZPOSVX' - INFOT = 1 - CALL ZPOSVX( '/', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 2 - CALL ZPOSVX( 'N', '/', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 3 - CALL ZPOSVX( 'N', 'U', -1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 4 - CALL ZPOSVX( 'N', 'U', 0, -1, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 6 - CALL ZPOSVX( 'N', 'U', 2, 0, A, 1, AF, 2, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 8 - CALL ZPOSVX( 'N', 'U', 2, 0, A, 2, AF, 1, EQ, C, B, 2, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 9 - EQ = '/' - CALL ZPOSVX( 'F', 'U', 0, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 10 - EQ = 'Y' - CALL ZPOSVX( 'F', 'U', 1, 0, A, 1, AF, 1, EQ, C, B, 1, X, 1, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 12 - CALL ZPOSVX( 'N', 'U', 2, 0, A, 2, AF, 2, EQ, C, B, 1, X, 2, - $ RCOND, R1, R2, W, IW, INFO ) - CALL CHKXER( 'ZPOSVX', INFOT, NOUT, INFO, OK ) - INFOT = 14 - ENDIF -* -* Print a summary line. -* - IF( OK ) THEN - WRITE( NOUT, FMT = 9999 )PATH - ELSE - WRITE( NOUT, FMT = 9998 )PATH - END IF -* - 9999 FORMAT( 1X, A3, ' drivers passed the tests of the error exits' ) - 9998 FORMAT( ' *** ', A3, ' drivers failed the tests of the error ', - $ 'exits ***' ) -* -* Enable CHAMELEON warnings/errors -* - CALL CHAMELEON_ENABLE( CHAMELEON_WARNINGS, INFO ) - CALL CHAMELEON_ENABLE( CHAMELEON_ERRORS, INFO ) -* - RETURN -* -* End of ZERRVX -* - END diff --git a/testing/lin/zgeequ.f b/testing/lin/zgeequ.f deleted file mode 100644 index 804a43b5e9ca0995353963ae622da6668bc30b2f..0000000000000000000000000000000000000000 --- a/testing/lin/zgeequ.f +++ /dev/null @@ -1,270 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, M, N - DOUBLE PRECISION AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - DOUBLE PRECISION C( * ), R( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZGEEQU computes row and column scalings intended to equilibrate an -* M-by-N matrix A and reduce its condition number. R returns the row -* scale factors and C the column scale factors, chosen to try to make -* the largest element in each row and column of the matrix B with -* elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1. -* -* R(i) and C(j) are restricted to be between SMLNUM = smallest safe -* number and BIGNUM = largest safe number. Use of these scaling -* factors is not guaranteed to reduce the condition number of A but -* works well in practice. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The M-by-N matrix whose equilibration factors are -* to be computed. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* R (output) DOUBLE PRECISION array, dimension (M) -* If INFO = 0 or INFO > M, R contains the row scale factors -* for A. -* -* C (output) DOUBLE PRECISION array, dimension (N) -* If INFO = 0, C contains the column scale factors for A. -* -* ROWCND (output) DOUBLE PRECISION -* If INFO = 0 or INFO > M, ROWCND contains the ratio of the -* smallest R(i) to the largest R(i). If ROWCND >= 0.1 and -* AMAX is neither too large nor too small, it is not worth -* scaling by R. -* -* COLCND (output) DOUBLE PRECISION -* If INFO = 0, COLCND contains the ratio of the smallest -* C(i) to the largest C(i). If COLCND >= 0.1, it is not -* worth scaling by C. -* -* AMAX (output) DOUBLE PRECISION -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= M: the i-th row of A is exactly zero -* > M: the (i-M)-th column of A is exactly zero -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION BIGNUM, RCMAX, RCMIN, SMLNUM - COMPLEX*16 ZDUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX, MIN -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZGEEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) THEN - ROWCND = ONE - COLCND = ONE - AMAX = ZERO - RETURN - END IF -* -* Get machine constants. -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* -* Compute row scale factors. -* - DO 10 I = 1, M - R( I ) = ZERO - 10 CONTINUE -* -* Find the maximum element in each row. -* - DO 30 J = 1, N - DO 20 I = 1, M - R( I ) = MAX( R( I ), CABS1( A( I, J ) ) ) - 20 CONTINUE - 30 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 40 I = 1, M - RCMAX = MAX( RCMAX, R( I ) ) - RCMIN = MIN( RCMIN, R( I ) ) - 40 CONTINUE - AMAX = RCMAX -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 50 I = 1, M - IF( R( I ).EQ.ZERO ) THEN - INFO = I - RETURN - END IF - 50 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 60 I = 1, M - R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) - 60 CONTINUE -* -* Compute ROWCND = min(R(I)) / max(R(I)) -* - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* -* Compute column scale factors -* - DO 70 J = 1, N - C( J ) = ZERO - 70 CONTINUE -* -* Find the maximum element in each column, -* assuming the row scaling computed above. -* - DO 90 J = 1, N - DO 80 I = 1, M - C( J ) = MAX( C( J ), CABS1( A( I, J ) )*R( I ) ) - 80 CONTINUE - 90 CONTINUE -* -* Find the maximum and minimum scale factors. -* - RCMIN = BIGNUM - RCMAX = ZERO - DO 100 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 100 CONTINUE -* - IF( RCMIN.EQ.ZERO ) THEN -* -* Find the first zero scale factor and return an error code. -* - DO 110 J = 1, N - IF( C( J ).EQ.ZERO ) THEN - INFO = M + J - RETURN - END IF - 110 CONTINUE - ELSE -* -* Invert the scale factors. -* - DO 120 J = 1, N - C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) - 120 CONTINUE -* -* Compute COLCND = min(C(J)) / max(C(J)) -* - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - END IF -* - RETURN -* -* End of ZGEEQU -* - END diff --git a/testing/lin/zgennd.f b/testing/lin/zgennd.f deleted file mode 100644 index 086d8df877fed3cdb1ff6e98050d832ecaf0b4ab..0000000000000000000000000000000000000000 --- a/testing/lin/zgennd.f +++ /dev/null @@ -1,97 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - LOGICAL FUNCTION ZGENND (M, N, A, LDA) - IMPLICIT NONE -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* February 2008 -* -* .. Scalar Arguments .. - INTEGER M, N, LDA -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZGENND tests that its argument has a real, non-negative diagonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows in A. -* -* N (input) INTEGER -* The number of columns in A. -* -* A (input) COMPLEX*16 array, dimension (LDA, N) -* The matrix. -* -* LDA (input) INTEGER -* Leading dimension of A. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO - PARAMETER ( ZERO = 0.0E0 ) -* .. -* .. Local Scalars .. - LOGICAL OUT - INTEGER I, K - COMPLEX*16 AII -* .. -* .. Intrinsics .. - INTRINSIC MIN, DBLE, DIMAG -* .. -* .. Executable Statements .. - K = MIN( M, N ) - DO I = 1, K - AII = A( I, I ) - IF( DBLE( AII ).LT.ZERO.OR.DIMAG( AII ).NE.ZERO ) THEN - ZGENND = .FALSE. - RETURN - END IF - END DO - ZGENND = .TRUE. - RETURN - END diff --git a/testing/lin/zgeqrs.f b/testing/lin/zgeqrs.f deleted file mode 100644 index 85a06a48f743c005ea960751f9fb45e69b07fb6b..0000000000000000000000000000000000000000 --- a/testing/lin/zgeqrs.f +++ /dev/null @@ -1,157 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, - $ INFO ) -* -* -- LAPACK routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), B( LDB, * ), TAU( * ), - $ WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* Solve the least squares problem -* min || A*X - B || -* using the QR factorization -* A = Q*R -* computed by ZGEQRF. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. M >= N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B. NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* Details of the QR factorization of the original matrix A as -* returned by ZGEQRF. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* TAU (input) COMPLEX*16 array, dimension (N) -* Details of the orthogonal matrix Q. -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the m-by-nrhs right hand side matrix B. -* On exit, the n-by-nrhs solution matrix X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= M. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of the array WORK. LWORK must be at least NRHS, -* and should be at least NRHS*NB, where NB is the block size -* for this environment. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZTRSM, ZUNMQR -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input arguments. -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 .OR. N.GT.M ) THEN - INFO = -2 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -5 - ELSE IF( LDB.LT.MAX( 1, M ) ) THEN - INFO = -8 - ELSE IF( LWORK.LT.1 .OR. LWORK.LT.NRHS .AND. M.GT.0 .AND. N.GT.0 ) - $ THEN - INFO = -10 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZGEQRS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. NRHS.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* -* B := Q' * B -* - CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A, LDA, - $ TAU, B, LDB, WORK, LWORK, INFO ) -* -* Solve R*X = B(1:n,:) -* - CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, NRHS, - $ ONE, A, LDA, B, LDB ) -* - RETURN -* -* End of ZGEQRS -* - END diff --git a/testing/lin/zget02.f b/testing/lin/zget02.f deleted file mode 100644 index 796dfbe568816edc0851716b45423461604c6441..0000000000000000000000000000000000000000 --- a/testing/lin/zget02.f +++ /dev/null @@ -1,185 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZGET02 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A^T*x = b, where A^T is the transpose of A -* = 'C': A^H*x = b, where A^H is the conjugate transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) . -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 CONE - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - DOUBLE PRECISION ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DZASUM, ZLANGE - EXTERNAL LSAME, DLAMCH, DZASUM, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - N1 = N - N2 = M - ELSE - N1 = M - N2 = N - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = ZLANGE( '1', N1, N2, A, LDA, RWORK ) - RHSNORM = ZLANGE( '1', N1, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL ZGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X, - $ LDX, CONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DZASUM( N1, B( 1, J ), 1 ) - XNORM = DZASUM( N2, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N1 *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of ZGET02 -* - END diff --git a/testing/lin/zget04.f b/testing/lin/zget04.f deleted file mode 100644 index e39badbae471d1ab0f063f1525cac293309d555e..0000000000000000000000000000000000000000 --- a/testing/lin/zget04.f +++ /dev/null @@ -1,161 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZGET04( N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDX, LDXACT, N, NRHS - DOUBLE PRECISION RCOND, RESID -* .. -* .. Array Arguments .. - COMPLEX*16 X( LDX, * ), XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* ZGET04 computes the difference between a computed solution and the -* true solution to a system of linear equations. -* -* RESID = ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ), -* where RCOND is the reciprocal of the condition number and EPS is the -* machine epsilon. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of rows of the matrices X and XACT. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and XACT. NRHS >= 0. -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* RCOND (input) DOUBLE PRECISION -* The reciprocal of the condition number of the coefficient -* matrix in the system of equations. -* -* RESID (output) DOUBLE PRECISION -* The maximum over the NRHS solution vectors of -* ( norm(X-XACT) * RCOND ) / ( norm(XACT) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, IX, J - DOUBLE PRECISION DIFFNM, EPS, XNORM - COMPLEX*16 ZDUM -* .. -* .. External Functions .. - INTEGER IZAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL IZAMAX, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if RCOND is invalid. -* - EPS = DLAMCH( 'Epsilon' ) - IF( RCOND.LT.ZERO ) THEN - RESID = 1.0D0 / EPS - RETURN - END IF -* -* Compute the maximum of -* norm(X - XACT) / ( norm(XACT) * EPS ) -* over all the vectors X and XACT . -* - RESID = ZERO - DO 20 J = 1, NRHS - IX = IZAMAX( N, XACT( 1, J ), 1 ) - XNORM = CABS1( XACT( IX, J ) ) - DIFFNM = ZERO - DO 10 I = 1, N - DIFFNM = MAX( DIFFNM, CABS1( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE - IF( XNORM.LE.ZERO ) THEN - IF( DIFFNM.GT.ZERO ) - $ RESID = 1.0D0 / EPS - ELSE - RESID = MAX( RESID, ( DIFFNM / XNORM )*RCOND ) - END IF - 20 CONTINUE - IF( RESID*EPS.LT.1.0D0 ) - $ RESID = RESID / EPS -* - RETURN -* -* End of ZGET04 -* - END diff --git a/testing/lin/zlacn2.f b/testing/lin/zlacn2.f deleted file mode 100644 index 1e1e8d16dd7e28c9609a6a6ca39eac00313ee5bc..0000000000000000000000000000000000000000 --- a/testing/lin/zlacn2.f +++ /dev/null @@ -1,258 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLACN2( N, V, X, EST, KASE, ISAVE ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER KASE, N - DOUBLE PRECISION EST -* .. -* .. Array Arguments .. - INTEGER ISAVE( 3 ) - COMPLEX*16 V( * ), X( * ) -* .. -* -* Purpose -* ======= -* -* ZLACN2 estimates the 1-norm of a square, complex matrix A. -* Reverse communication is used for evaluating matrix-vector products. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix. N >= 1. -* -* V (workspace) COMPLEX*16 array, dimension (N) -* On the final return, V = A*W, where EST = norm(V)/norm(W) -* (W is not returned). -* -* X (input/output) COMPLEX*16 array, dimension (N) -* On an intermediate return, X should be overwritten by -* A * X, if KASE=1, -* A' * X, if KASE=2, -* where A' is the conjugate transpose of A, and ZLACN2 must be -* re-called with all the other parameters unchanged. -* -* EST (input/output) DOUBLE PRECISION -* On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be -* unchanged from the previous call to ZLACN2. -* On exit, EST is an estimate (a lower bound) for norm(A). -* -* KASE (input/output) INTEGER -* On the initial call to ZLACN2, KASE should be 0. -* On an intermediate return, KASE will be 1 or 2, indicating -* whether X should be overwritten by A * X or A' * X. -* On the final return from ZLACN2, KASE will again be 0. -* -* ISAVE (input/output) INTEGER array, dimension (3) -* ISAVE is used to save variables between calls to ZLACN2 -* -* Further Details -* ======= ======= -* -* Contributed by Nick Higham, University of Manchester. -* Originally named CONEST, dated March 16, 1988. -* -* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of -* a real or complex matrix, with applications to condition estimation", -* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. -* -* Last modified: April, 1999 -* -* This is a thread safe version of ZLACON, which uses the array ISAVE -* in place of a SAVE statement, as follows: -* -* ZLACON ZLACN2 -* JUMP ISAVE(1) -* J ISAVE(2) -* ITER ISAVE(3) -* -* ===================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - DOUBLE PRECISION ONE, TWO - PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 ) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), - $ CONE = ( 1.0D0, 0.0D0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, JLAST - DOUBLE PRECISION ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP -* .. -* .. External Functions .. - INTEGER IZMAX1 - DOUBLE PRECISION DLAMCH, DZSUM1 - EXTERNAL IZMAX1, DLAMCH, DZSUM1 -* .. -* .. External Subroutines .. - EXTERNAL ZCOPY -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DCMPLX, DIMAG -* .. -* .. Executable Statements .. -* - SAFMIN = DLAMCH( 'Safe minimum' ) - IF( KASE.EQ.0 ) THEN - DO 10 I = 1, N - X( I ) = DCMPLX( ONE / DBLE( N ) ) - 10 CONTINUE - KASE = 1 - ISAVE( 1 ) = 1 - RETURN - END IF -* - GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 ) -* -* ................ ENTRY (ISAVE( 1 ) = 1) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. -* - 20 CONTINUE - IF( N.EQ.1 ) THEN - V( 1 ) = X( 1 ) - EST = ABS( V( 1 ) ) -* ... QUIT - GO TO 130 - END IF - EST = DZSUM1( N, X, 1 ) -* - DO 30 I = 1, N - ABSXI = ABS( X( I ) ) - IF( ABSXI.GT.SAFMIN ) THEN - X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI, - $ DIMAG( X( I ) ) / ABSXI ) - ELSE - X( I ) = CONE - END IF - 30 CONTINUE - KASE = 2 - ISAVE( 1 ) = 2 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 2) -* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. -* - 40 CONTINUE - ISAVE( 2 ) = IZMAX1( N, X, 1 ) - ISAVE( 3 ) = 2 -* -* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. -* - 50 CONTINUE - DO 60 I = 1, N - X( I ) = CZERO - 60 CONTINUE - X( ISAVE( 2 ) ) = CONE - KASE = 1 - ISAVE( 1 ) = 3 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 3) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 70 CONTINUE - CALL ZCOPY( N, X, 1, V, 1 ) - ESTOLD = EST - EST = DZSUM1( N, V, 1 ) -* -* TEST FOR CYCLING. - IF( EST.LE.ESTOLD ) - $ GO TO 100 -* - DO 80 I = 1, N - ABSXI = ABS( X( I ) ) - IF( ABSXI.GT.SAFMIN ) THEN - X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI, - $ DIMAG( X( I ) ) / ABSXI ) - ELSE - X( I ) = CONE - END IF - 80 CONTINUE - KASE = 2 - ISAVE( 1 ) = 4 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 4) -* X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. -* - 90 CONTINUE - JLAST = ISAVE( 2 ) - ISAVE( 2 ) = IZMAX1( N, X, 1 ) - IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND. - $ ( ISAVE( 3 ).LT.ITMAX ) ) THEN - ISAVE( 3 ) = ISAVE( 3 ) + 1 - GO TO 50 - END IF -* -* ITERATION COMPLETE. FINAL STAGE. -* - 100 CONTINUE - ALTSGN = ONE - DO 110 I = 1, N - X( I ) = DCMPLX( ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) ) - ALTSGN = -ALTSGN - 110 CONTINUE - KASE = 1 - ISAVE( 1 ) = 5 - RETURN -* -* ................ ENTRY (ISAVE( 1 ) = 5) -* X HAS BEEN OVERWRITTEN BY A*X. -* - 120 CONTINUE - TEMP = TWO*( DZSUM1( N, X, 1 ) / DBLE( 3*N ) ) - IF( TEMP.GT.EST ) THEN - CALL ZCOPY( N, X, 1, V, 1 ) - EST = TEMP - END IF -* - 130 CONTINUE - KASE = 0 - RETURN -* -* End of ZLACN2 -* - END diff --git a/testing/lin/zlagge.f b/testing/lin/zlagge.f deleted file mode 100644 index 47d438ef81663bce90adfdde4fca226fc547a0bb..0000000000000000000000000000000000000000 --- a/testing/lin/zlagge.f +++ /dev/null @@ -1,331 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAGGE( M, N, KL, KU, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, KL, KU, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION D( * ) - COMPLEX*16 A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZLAGGE generates a complex general m by n matrix A, by pre- and post- -* multiplying a real diagonal matrix D with random unitary matrices: -* A = U*D*V. The lower and upper bandwidths may then be reduced to -* kl and ku by additional unitary transformations. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= KL <= M-1. -* -* KU (input) INTEGER -* The number of nonzero superdiagonals within the band of A. -* 0 <= KU <= N-1. -* -* D (input) DOUBLE PRECISION array, dimension (min(M,N)) -* The diagonal elements of the diagonal matrix D. -* -* A (output) COMPLEX*16 array, dimension (LDA,N) -* The generated m by n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) COMPLEX*16 array, dimension (M+N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO, ONE - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), - $ ONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION WN - COMPLEX*16 TAU, WA, WB -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGEMV, ZGERC, ZLACGV, ZLARNV, ZSCAL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, MIN -* .. -* .. External Functions .. - DOUBLE PRECISION DZNRM2 - EXTERNAL DZNRM2 -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN - INFO = -3 - ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -7 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'ZLAGGE', -INFO ) - RETURN - END IF -* -* initialize A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = 1, M - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( M, N ) - A( I, I ) = D( I ) - 30 CONTINUE -* -* pre- and post-multiply A by random unitary matrices -* - DO 40 I = MIN( M, N ), 1, -1 - IF( I.LT.M ) THEN -* -* generate random reflection -* - CALL ZLARNV( 3, ISEED, M-I+1, WORK ) - WN = DZNRM2( M-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL ZSCAL( M-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* multiply A(i:m,i:n) by random reflection from the left -* - CALL ZGEMV( 'Conjugate transpose', M-I+1, N-I+1, ONE, - $ A( I, I ), LDA, WORK, 1, ZERO, WORK( M+1 ), 1 ) - CALL ZGERC( M-I+1, N-I+1, -TAU, WORK, 1, WORK( M+1 ), 1, - $ A( I, I ), LDA ) - END IF - IF( I.LT.N ) THEN -* -* generate random reflection -* - CALL ZLARNV( 3, ISEED, N-I+1, WORK ) - WN = DZNRM2( N-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL ZSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* multiply A(i:m,i:n) by random reflection from the right -* - CALL ZGEMV( 'No transpose', M-I+1, N-I+1, ONE, A( I, I ), - $ LDA, WORK, 1, ZERO, WORK( N+1 ), 1 ) - CALL ZGERC( M-I+1, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, - $ A( I, I ), LDA ) - END IF - 40 CONTINUE -* -* Reduce number of subdiagonals to KL and number of superdiagonals -* to KU -* - DO 70 I = 1, MAX( M-1-KL, N-1-KU ) - IF( KL.LE.KU ) THEN -* -* annihilate subdiagonal elements first (necessary if KL = 0) -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = DZNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = ( WN / ABS( A( KL+I, I ) ) )*A( KL+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL ZSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL ZGEMV( 'Conjugate transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL ZGERC( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, - $ 1, A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = DZNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = ( WN / ABS( A( I, KU+I ) ) )*A( I, KU+I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL ZSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL ZLACGV( N-KU-I+1, A( I, KU+I ), LDA ) - CALL ZGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL ZGERC( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF - ELSE -* -* annihilate superdiagonal elements first (necessary if -* KU = 0) -* - IF( I.LE.MIN( N-1-KU, M ) ) THEN -* -* generate reflection to annihilate A(i,ku+i+1:n) -* - WN = DZNRM2( N-KU-I+1, A( I, KU+I ), LDA ) - WA = ( WN / ABS( A( I, KU+I ) ) )*A( I, KU+I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( I, KU+I ) + WA - CALL ZSCAL( N-KU-I, ONE / WB, A( I, KU+I+1 ), LDA ) - A( I, KU+I ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply reflection to A(i+1:m,ku+i:n) from the right -* - CALL ZLACGV( N-KU-I+1, A( I, KU+I ), LDA ) - CALL ZGEMV( 'No transpose', M-I, N-KU-I+1, ONE, - $ A( I+1, KU+I ), LDA, A( I, KU+I ), LDA, ZERO, - $ WORK, 1 ) - CALL ZGERC( M-I, N-KU-I+1, -TAU, WORK, 1, A( I, KU+I ), - $ LDA, A( I+1, KU+I ), LDA ) - A( I, KU+I ) = -WA - END IF -* - IF( I.LE.MIN( M-1-KL, N ) ) THEN -* -* generate reflection to annihilate A(kl+i+1:m,i) -* - WN = DZNRM2( M-KL-I+1, A( KL+I, I ), 1 ) - WA = ( WN / ABS( A( KL+I, I ) ) )*A( KL+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( KL+I, I ) + WA - CALL ZSCAL( M-KL-I, ONE / WB, A( KL+I+1, I ), 1 ) - A( KL+I, I ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply reflection to A(kl+i:m,i+1:n) from the left -* - CALL ZGEMV( 'Conjugate transpose', M-KL-I+1, N-I, ONE, - $ A( KL+I, I+1 ), LDA, A( KL+I, I ), 1, ZERO, - $ WORK, 1 ) - CALL ZGERC( M-KL-I+1, N-I, -TAU, A( KL+I, I ), 1, WORK, - $ 1, A( KL+I, I+1 ), LDA ) - A( KL+I, I ) = -WA - END IF - END IF -* - DO 50 J = KL + I + 1, M - A( J, I ) = ZERO - 50 CONTINUE -* - DO 60 J = KU + I + 1, N - A( I, J ) = ZERO - 60 CONTINUE - 70 CONTINUE - RETURN -* -* End of ZLAGGE -* - END diff --git a/testing/lin/zlagsy.f b/testing/lin/zlagsy.f deleted file mode 100644 index a9366c90c0bb3eae64e7d50abc109f655d414ad1..0000000000000000000000000000000000000000 --- a/testing/lin/zlagsy.f +++ /dev/null @@ -1,260 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAGSY( N, K, D, A, LDA, ISEED, WORK, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, K, LDA, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION D( * ) - COMPLEX*16 A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZLAGSY generates a complex symmetric matrix A, by pre- and post- -* multiplying a real diagonal matrix D with a random unitary matrix: -* A = U*D*U^T. The semi-bandwidth may then be reduced to k by -* additional unitary transformations. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* K (input) INTEGER -* The number of nonzero subdiagonals within the band of A. -* 0 <= K <= N-1. -* -* D (input) DOUBLE PRECISION array, dimension (N) -* The diagonal elements of the diagonal matrix D. -* -* A (output) COMPLEX*16 array, dimension (LDA,N) -* The generated n by n symmetric matrix A (the full matrix is -* stored). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= N. -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* WORK (workspace) COMPLEX*16 array, dimension (2*N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ZERO, ONE, HALF - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), - $ ONE = ( 1.0D+0, 0.0D+0 ), - $ HALF = ( 0.5D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, II, J, JJ - DOUBLE PRECISION WN - COMPLEX*16 ALPHA, TAU, WA, WB -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZGEMV, ZGERC, ZLACGV, ZLARNV, - $ ZSCAL, ZSYMV -* .. -* .. External Functions .. - DOUBLE PRECISION DZNRM2 - COMPLEX*16 ZDOTC - EXTERNAL DZNRM2, ZDOTC -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( K.LT.0 .OR. K.GT.N-1 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.LT.0 ) THEN - CALL XERBLA( 'ZLAGSY', -INFO ) - RETURN - END IF -* -* initialize lower triangle of A to diagonal matrix -* - DO 20 J = 1, N - DO 10 I = J + 1, N - A( I, J ) = ZERO - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, N - A( I, I ) = D( I ) - 30 CONTINUE -* -* Generate lower triangle of symmetric matrix -* - DO 60 I = N - 1, 1, -1 -* -* generate random reflection -* - CALL ZLARNV( 3, ISEED, N-I+1, WORK ) - WN = DZNRM2( N-I+1, WORK, 1 ) - WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = WORK( 1 ) + WA - CALL ZSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) - WORK( 1 ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply random reflection to A(i:n,i:n) from the left -* and the right -* -* compute y := tau * A * conjg(u) -* - CALL ZLACGV( N-I+1, WORK, 1 ) - CALL ZSYMV( 'Lower', N-I+1, TAU, A( I, I ), LDA, WORK, 1, ZERO, - $ WORK( N+1 ), 1 ) - CALL ZLACGV( N-I+1, WORK, 1 ) -* -* compute v := y - 1/2 * tau * ( u, y ) * u -* - ALPHA = -HALF*TAU*ZDOTC( N-I+1, WORK, 1, WORK( N+1 ), 1 ) - CALL ZAXPY( N-I+1, ALPHA, WORK, 1, WORK( N+1 ), 1 ) -* -* apply the transformation as a rank-2 update to A(i:n,i:n) -* -* CALL ZSYR2( 'Lower', N-I+1, -ONE, WORK, 1, WORK( N+1 ), 1, -* $ A( I, I ), LDA ) -* - DO 50 JJ = I, N - DO 40 II = JJ, N - A( II, JJ ) = A( II, JJ ) - - $ WORK( II-I+1 )*WORK( N+JJ-I+1 ) - - $ WORK( N+II-I+1 )*WORK( JJ-I+1 ) - 40 CONTINUE - 50 CONTINUE - 60 CONTINUE -* -* Reduce number of subdiagonals to K -* - DO 100 I = 1, N - 1 - K -* -* generate reflection to annihilate A(k+i+1:n,i) -* - WN = DZNRM2( N-K-I+1, A( K+I, I ), 1 ) - WA = ( WN / ABS( A( K+I, I ) ) )*A( K+I, I ) - IF( WN.EQ.ZERO ) THEN - TAU = ZERO - ELSE - WB = A( K+I, I ) + WA - CALL ZSCAL( N-K-I, ONE / WB, A( K+I+1, I ), 1 ) - A( K+I, I ) = ONE - TAU = DBLE( WB / WA ) - END IF -* -* apply reflection to A(k+i:n,i+1:k+i-1) from the left -* - CALL ZGEMV( 'Conjugate transpose', N-K-I+1, K-1, ONE, - $ A( K+I, I+1 ), LDA, A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL ZGERC( N-K-I+1, K-1, -TAU, A( K+I, I ), 1, WORK, 1, - $ A( K+I, I+1 ), LDA ) -* -* apply reflection to A(k+i:n,k+i:n) from the left and the right -* -* compute y := tau * A * conjg(u) -* - CALL ZLACGV( N-K-I+1, A( K+I, I ), 1 ) - CALL ZSYMV( 'Lower', N-K-I+1, TAU, A( K+I, K+I ), LDA, - $ A( K+I, I ), 1, ZERO, WORK, 1 ) - CALL ZLACGV( N-K-I+1, A( K+I, I ), 1 ) -* -* compute v := y - 1/2 * tau * ( u, y ) * u -* - ALPHA = -HALF*TAU*ZDOTC( N-K-I+1, A( K+I, I ), 1, WORK, 1 ) - CALL ZAXPY( N-K-I+1, ALPHA, A( K+I, I ), 1, WORK, 1 ) -* -* apply symmetric rank-2 update to A(k+i:n,k+i:n) -* -* CALL ZSYR2( 'Lower', N-K-I+1, -ONE, A( K+I, I ), 1, WORK, 1, -* $ A( K+I, K+I ), LDA ) -* - DO 80 JJ = K + I, N - DO 70 II = JJ, N - A( II, JJ ) = A( II, JJ ) - A( II, I )*WORK( JJ-K-I+1 ) - - $ WORK( II-K-I+1 )*A( JJ, I ) - 70 CONTINUE - 80 CONTINUE -* - A( K+I, I ) = -WA - DO 90 J = K + I + 1, N - A( J, I ) = ZERO - 90 CONTINUE - 100 CONTINUE -* -* Store full symmetric matrix -* - DO 120 J = 1, N - DO 110 I = J + 1, N - A( J, I ) = A( I, J ) - 110 CONTINUE - 120 CONTINUE - RETURN -* -* End of ZLAGSY -* - END diff --git a/testing/lin/zlaipd.f b/testing/lin/zlaipd.f deleted file mode 100644 index b56c55154200d898a23ba9b36ff935da8bf9350b..0000000000000000000000000000000000000000 --- a/testing/lin/zlaipd.f +++ /dev/null @@ -1,110 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAIPD( N, A, INDA, VINDA ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INDA, N, VINDA -* .. -* .. Array Arguments .. - COMPLEX*16 A( * ) -* .. -* -* Purpose -* ======= -* -* ZLAIPD sets the imaginary part of the diagonal elements of a complex -* matrix A to a large value. This is used to test LAPACK routines for -* complex Hermitian matrices, which are not supposed to access or use -* the imaginary parts of the diagonals. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The number of diagonal elements of A. -* -* A (input/output) COMPLEX*16 array, dimension -* (1+(N-1)*INDA+(N-2)*VINDA) -* On entry, the complex (Hermitian) matrix A. -* On exit, the imaginary parts of the diagonal elements are set -* to BIGNUM = EPS / SAFMIN, where EPS is the machine epsilon and -* SAFMIN is the safe minimum. -* -* INDA (input) INTEGER -* The increment between A(1) and the next diagonal element of A. -* Typical values are -* = LDA+1: square matrices with leading dimension LDA -* = 2: packed upper triangular matrix, starting at A(1,1) -* = N: packed lower triangular matrix, starting at A(1,1) -* -* VINDA (input) INTEGER -* The change in the diagonal increment between columns of A. -* Typical values are -* = 0: no change, the row and column increments in A are fixed -* = 1: packed upper triangular matrix -* = -1: packed lower triangular matrix -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, IA, IXA - DOUBLE PRECISION BIGNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX -* .. -* .. Executable Statements .. -* - BIGNUM = DLAMCH( 'Epsilon' ) / DLAMCH( 'Safe minimum' ) - IA = 1 - IXA = INDA - DO 10 I = 1, N - A( IA ) = DCMPLX( DBLE( A( IA ) ), BIGNUM ) - IA = IA + IXA - IXA = IXA + VINDA - 10 CONTINUE - RETURN - END diff --git a/testing/lin/zlanhe.f b/testing/lin/zlanhe.f deleted file mode 100644 index 664ca5d31616c915f852b0689bf1a60830eb32f6..0000000000000000000000000000000000000000 --- a/testing/lin/zlanhe.f +++ /dev/null @@ -1,224 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER NORM, UPLO - INTEGER LDA, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION WORK( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLANHE returns the value of the one norm, or the Frobenius norm, or -* the infinity norm, or the element of largest absolute value of a -* complex hermitian matrix A. -* -* Description -* =========== -* -* ZLANHE returns the value -* -* ZLANHE = ( max(abs(A(i,j))), NORM = 'M' or 'm' -* ( -* ( norm1(A), NORM = '1', 'O' or 'o' -* ( -* ( normI(A), NORM = 'I' or 'i' -* ( -* ( normF(A), NORM = 'F', 'f', 'E' or 'e' -* -* where norm1 denotes the one norm of a matrix (maximum column sum), -* normI denotes the infinity norm of a matrix (maximum row sum) and -* normF denotes the Frobenius norm of a matrix (square root of sum of -* squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. -* -* Arguments -* ========= -* -* NORM (input) CHARACTER*1 -* Specifies the value to be returned in ZLANHE as described -* above. -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* hermitian matrix A is to be referenced. -* = 'U': Upper triangular part of A is referenced -* = 'L': Lower triangular part of A is referenced -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. When N = 0, ZLANHE is -* set to zero. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* 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. Note that the imaginary parts of the diagonal -* elements need not be set and are assumed to be zero. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), -* where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise, -* WORK is not referenced. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL ZLASSQ -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, SQRT -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 ) THEN - VALUE = ZERO - ELSE IF( LSAME( NORM, 'M' ) ) THEN -* -* Find max(abs(A(i,j))). -* - VALUE = ZERO - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) - 10 CONTINUE - VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) ) - 20 CONTINUE - ELSE - DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) ) - DO 30 I = J + 1, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. - $ ( NORM.EQ.'1' ) ) THEN -* -* Find normI(A) ( = norm1(A), since A is hermitian). -* - VALUE = ZERO - IF( LSAME( UPLO, 'U' ) ) THEN - DO 60 J = 1, N - SUM = ZERO - DO 50 I = 1, J - 1 - ABSA = ABS( A( I, J ) ) - SUM = SUM + ABSA - WORK( I ) = WORK( I ) + ABSA - 50 CONTINUE - WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) ) - 60 CONTINUE - DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) - 70 CONTINUE - ELSE - DO 80 I = 1, N - WORK( I ) = ZERO - 80 CONTINUE - DO 100 J = 1, N - SUM = WORK( J ) + ABS( DBLE( A( J, J ) ) ) - DO 90 I = J + 1, N - ABSA = ABS( A( I, J ) ) - SUM = SUM + ABSA - WORK( I ) = WORK( I ) + ABSA - 90 CONTINUE - VALUE = MAX( VALUE, SUM ) - 100 CONTINUE - END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN -* -* Find normF(A). -* - SCALE = ZERO - SUM = ONE - IF( LSAME( UPLO, 'U' ) ) THEN - DO 110 J = 2, N - CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) - 110 CONTINUE - ELSE - DO 120 J = 1, N - 1 - CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) - 120 CONTINUE - END IF - SUM = 2*SUM - DO 130 I = 1, N - IF( DBLE( A( I, I ) ).NE.ZERO ) THEN - ABSA = ABS( DBLE( A( I, I ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA - ELSE - SUM = SUM + ( ABSA / SCALE )**2 - END IF - END IF - 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) - END IF -* - ZLANHE = VALUE - RETURN -* -* End of ZLANHE -* - END diff --git a/testing/lin/zlaqge.f b/testing/lin/zlaqge.f deleted file mode 100644 index ceb6147c2f2173f43b6fbd77b1b14a8569ca3391..0000000000000000000000000000000000000000 --- a/testing/lin/zlaqge.f +++ /dev/null @@ -1,192 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED - INTEGER LDA, M, N - DOUBLE PRECISION AMAX, COLCND, ROWCND -* .. -* .. Array Arguments .. - DOUBLE PRECISION C( * ), R( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLAQGE equilibrates a general M by N matrix A using the row and -* column scaling factors in the vectors R and C. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the M by N matrix A. -* On exit, the equilibrated matrix. See EQUED for the form of -* the equilibrated matrix. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(M,1). -* -* R (input) DOUBLE PRECISION array, dimension (M) -* The row scale factors for A. -* -* C (input) DOUBLE PRECISION array, dimension (N) -* The column scale factors for A. -* -* ROWCND (input) DOUBLE PRECISION -* Ratio of the smallest R(i) to the largest R(i). -* -* COLCND (input) DOUBLE PRECISION -* Ratio of the smallest C(i) to the largest C(i). -* -* AMAX (input) DOUBLE PRECISION -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration -* = 'R': Row equilibration, i.e., A has been premultiplied by -* diag(R). -* = 'C': Column equilibration, i.e., A has been postmultiplied -* by diag(C). -* = 'B': Both row and column equilibration, i.e., A has been -* replaced by diag(R) * A * diag(C). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if row or column scaling -* should be done based on the ratio of the row or column scaling -* factors. If ROWCND < THRESH, row scaling is done, and if -* COLCND < THRESH, column scaling is done. -* -* LARGE and SMALL are threshold values used to decide if row scaling -* should be done based on the absolute size of the largest matrix -* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, THRESH - PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION CJ, LARGE, SMALL -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH - EXTERNAL DLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( M.LE.0 .OR. N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) - $ THEN -* -* No row scaling -* - IF( COLCND.GE.THRESH ) THEN -* -* No column scaling -* - EQUED = 'N' - ELSE -* -* Column scaling -* - DO 20 J = 1, N - CJ = C( J ) - DO 10 I = 1, M - A( I, J ) = CJ*A( I, J ) - 10 CONTINUE - 20 CONTINUE - EQUED = 'C' - END IF - ELSE IF( COLCND.GE.THRESH ) THEN -* -* Row scaling, no column scaling -* - DO 40 J = 1, N - DO 30 I = 1, M - A( I, J ) = R( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - EQUED = 'R' - ELSE -* -* Row and column scaling -* - DO 60 J = 1, N - CJ = C( J ) - DO 50 I = 1, M - A( I, J ) = CJ*R( I )*A( I, J ) - 50 CONTINUE - 60 CONTINUE - EQUED = 'B' - END IF -* - RETURN -* -* End of ZLAQGE -* - END diff --git a/testing/lin/zlaqhe.f b/testing/lin/zlaqhe.f deleted file mode 100644 index 76fac85f05dd616ed973b8b73e0bfd818287356c..0000000000000000000000000000000000000000 --- a/testing/lin/zlaqhe.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - DOUBLE PRECISION AMAX, SCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION S( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLAQHE equilibrates a Hermitian matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) DOUBLE PRECISION array, dimension (N) -* The scale factors for A. -* -* SCOND (input) DOUBLE PRECISION -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) DOUBLE PRECISION -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, THRESH - PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - 1 - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - A( J, J ) = CJ*CJ*DBLE( A( J, J ) ) - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - A( J, J ) = CJ*CJ*DBLE( A( J, J ) ) - DO 30 I = J + 1, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of ZLAQHE -* - END diff --git a/testing/lin/zlaqsy.f b/testing/lin/zlaqsy.f deleted file mode 100644 index 7f5ebd538eb3b95f2d8a8d4d31f64f73820984f7..0000000000000000000000000000000000000000 --- a/testing/lin/zlaqsy.f +++ /dev/null @@ -1,179 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, UPLO - INTEGER LDA, N - DOUBLE PRECISION AMAX, SCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION S( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLAQSY equilibrates a symmetric matrix A using the scaling factors -* in the vector S. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the symmetric 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 EQUED = 'Y', the equilibrated matrix: -* diag(S) * A * diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(N,1). -* -* S (input) DOUBLE PRECISION array, dimension (N) -* The scale factors for A. -* -* SCOND (input) DOUBLE PRECISION -* Ratio of the smallest S(i) to the largest S(i). -* -* AMAX (input) DOUBLE PRECISION -* Absolute value of largest matrix entry. -* -* EQUED (output) CHARACTER*1 -* Specifies whether or not equilibration was done. -* = 'N': No equilibration. -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* -* Internal Parameters -* =================== -* -* THRESH is a threshold value used to decide if scaling should be done -* based on the ratio of the scaling factors. If SCOND < THRESH, -* scaling is done. -* -* LARGE and SMALL are threshold values used to decide if scaling should -* be done based on the absolute size of the largest matrix element. -* If AMAX > LARGE or AMAX < SMALL, scaling is done. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, THRESH - PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION CJ, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH -* .. -* .. Executable Statements .. -* -* Quick return if possible -* - IF( N.LE.0 ) THEN - EQUED = 'N' - RETURN - END IF -* -* Initialize LARGE and SMALL. -* - SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - LARGE = ONE / SMALL -* - IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN -* -* No equilibration -* - EQUED = 'N' - ELSE -* -* Replace A by diag(S) * A * diag(S). -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Upper triangle of A is stored. -* - DO 20 J = 1, N - CJ = S( J ) - DO 10 I = 1, J - A( I, J ) = CJ*S( I )*A( I, J ) - 10 CONTINUE - 20 CONTINUE - ELSE -* -* Lower triangle of A is stored. -* - DO 40 J = 1, N - CJ = S( J ) - DO 30 I = J, N - A( I, J ) = CJ*S( I )*A( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - EQUED = 'Y' - END IF -* - RETURN -* -* End of ZLAQSY -* - END diff --git a/testing/lin/zlarhs.f b/testing/lin/zlarhs.f deleted file mode 100644 index 333feeb719caa639981cb8dea8404a1208543ce7..0000000000000000000000000000000000000000 --- a/testing/lin/zlarhs.f +++ /dev/null @@ -1,390 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, - $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS, UPLO, XTYPE - CHARACTER*3 PATH - INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZLARHS chooses a set of NRHS random solution vectors and sets -* up the right hand sides for the linear system -* op( A ) * X = B, -* where op( A ) may be A, A^T (transpose of A), or A^H (conjugate -* transpose of A). -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The type of the complex matrix A. PATH may be given in any -* combination of upper and lower case. Valid paths include -* xGE: General m x n matrix -* xGB: General banded matrix -* xPO: Hermitian positive definite, 2-D storage -* xPP: Hermitian positive definite packed -* xPB: Hermitian positive definite banded -* xHE: Hermitian indefinite, 2-D storage -* xHP: Hermitian indefinite packed -* xHB: Hermitian indefinite banded -* xSY: Symmetric indefinite, 2-D storage -* xSP: Symmetric indefinite packed -* xSB: Symmetric indefinite banded -* xTR: Triangular -* xTP: Triangular packed -* xTB: Triangular banded -* xQR: General m x n matrix -* xLQ: General m x n matrix -* xQL: General m x n matrix -* xRQ: General m x n matrix -* where the leading character indicates the precision. -* -* XTYPE (input) CHARACTER*1 -* Specifies how the exact solution X will be determined: -* = 'N': New solution; generate a random X. -* = 'C': Computed; use value of X on entry. -* -* UPLO (input) CHARACTER*1 -* Used only if A is symmetric or triangular; specifies whether -* the upper or lower triangular part of the matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Used only if A is nonsymmetric; specifies the operation -* applied to the matrix A. -* = 'N': B := A * X -* = 'T': B := A^T * X -* = 'C': B := A^H * X -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* KL (input) INTEGER -* Used only if A is a band matrix; specifies the number of -* subdiagonals of A if A is a general band matrix or if A is -* symmetric or triangular and UPLO = 'L'; specifies the number -* of superdiagonals of A if A is symmetric or triangular and -* UPLO = 'U'. 0 <= KL <= M-1. -* -* KU (input) INTEGER -* Used only if A is a general band matrix or if A is -* triangular. -* -* If PATH = xGB, specifies the number of superdiagonals of A, -* and 0 <= KU <= N-1. -* -* If PATH = xTR, xTP, or xTB, specifies whether or not the -* matrix has unit diagonal: -* = 1: matrix has non-unit diagonal (default) -* = 2: matrix has unit diagonal -* -* NRHS (input) INTEGER -* The number of right hand side vectors in the system A*X = B. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The test matrix whose type is given by PATH. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* If PATH = xGB, LDA >= KL+KU+1. -* If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. -* Otherwise, LDA >= max(1,M). -* -* X (input or output) COMPLEX*16 array, dimension (LDX,NRHS) -* On entry, if XTYPE = 'C' (for 'Computed'), then X contains -* the exact solution to the system of linear equations. -* On exit, if XTYPE = 'N' (for 'New'), then X is initialized -* with random values. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). -* -* B (output) COMPLEX*16 array, dimension (LDB,NRHS) -* The right hand side vector(s) for the system of equations, -* computed from B = op(A) * X, where op(A) is determined by -* TRANS. -* -* LDB (input) INTEGER -* The leading dimension of the array B. If TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). -* -* ISEED (input/output) INTEGER array, dimension (4) -* The seed vector for the random number generator (used in -* ZLATMS). Modified on exit. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE, ZERO - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI - CHARACTER C1, DIAG - CHARACTER*2 C2 - INTEGER J, MB, NX -* .. -* .. External Functions .. - LOGICAL LSAME, LSAMEN - EXTERNAL LSAME, LSAMEN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGBMV, ZGEMM, ZHBMV, ZHEMM, ZHPMV, - $ ZLACPY, ZLARNV, ZSBMV, ZSPMV, ZSYMM, ZTBMV, - $ ZTPMV, ZTRMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - C1 = PATH( 1: 1 ) - C2 = PATH( 2: 3 ) - TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) - NOTRAN = .NOT.TRAN - GEN = LSAME( PATH( 2: 2 ), 'G' ) - QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) - SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. - $ LSAME( PATH( 2: 2 ), 'S' ) .OR. LSAME( PATH( 2: 2 ), 'H' ) - TRI = LSAME( PATH( 2: 2 ), 'T' ) - BAND = LSAME( PATH( 3: 3 ), 'B' ) - IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN - INFO = -1 - ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) - $ THEN - INFO = -2 - ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. - $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN - INFO = -3 - ELSE IF( ( GEN .OR. QRS ) .AND. .NOT. - $ ( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN - INFO = -4 - ELSE IF( M.LT.0 ) THEN - INFO = -5 - ELSE IF( N.LT.0 ) THEN - INFO = -6 - ELSE IF( BAND .AND. KL.LT.0 ) THEN - INFO = -7 - ELSE IF( BAND .AND. KU.LT.0 ) THEN - INFO = -8 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -9 - ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. - $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. - $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN - INFO = -11 - ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. - $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN - INFO = -13 - ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. - $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN - INFO = -15 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLARHS', -INFO ) - RETURN - END IF -* -* Initialize X to NRHS random vectors unless XTYPE = 'C'. -* - IF( TRAN ) THEN - NX = M - MB = N - ELSE - NX = N - MB = M - END IF - IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN - DO 10 J = 1, NRHS - CALL ZLARNV( 2, ISEED, N, X( 1, J ) ) - 10 CONTINUE - END IF -* -* Multiply X by op( A ) using an appropriate -* matrix multiply routine. -* - IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. - $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. - $ LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* General matrix -* - CALL ZGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, - $ ZERO, B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'HE' ) ) THEN -* -* Hermitian matrix, 2-D storage -* - CALL ZHEMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN -* -* Symmetric matrix, 2-D storage -* - CALL ZSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, - $ B, LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* General matrix, band storage -* - DO 20 J = 1, NRHS - CALL ZGBMV( TRANS, M, N, KL, KU, ONE, A, LDA, X( 1, J ), 1, - $ ZERO, B( 1, J ), 1 ) - 20 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) .OR. LSAMEN( 2, C2, 'HB' ) ) THEN -* -* Hermitian matrix, band storage -* - DO 30 J = 1, NRHS - CALL ZHBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 30 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'SB' ) ) THEN -* -* Symmetric matrix, band storage -* - DO 40 J = 1, NRHS - CALL ZSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, - $ B( 1, J ), 1 ) - 40 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'HP' ) ) THEN -* -* Hermitian matrix, packed storage -* - DO 50 J = 1, NRHS - CALL ZHPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 50 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN -* -* Symmetric matrix, packed storage -* - DO 60 J = 1, NRHS - CALL ZSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), - $ 1 ) - 60 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN -* -* Triangular matrix. Note that for triangular matrices, -* KU = 1 => non-unit triangular -* KU = 2 => unit triangular -* - CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - CALL ZTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, - $ LDB ) -* - ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN -* -* Triangular matrix, packed storage -* - CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 70 J = 1, NRHS - CALL ZTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) - 70 CONTINUE -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* Triangular matrix, banded storage -* - CALL ZLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) - IF( KU.EQ.2 ) THEN - DIAG = 'U' - ELSE - DIAG = 'N' - END IF - DO 80 J = 1, NRHS - CALL ZTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) - 80 CONTINUE -* - ELSE -* -* If none of the above, set INFO = -1 and return -* - INFO = -1 - CALL XERBLA( 'ZLARHS', -INFO ) - END IF -* - RETURN -* -* End of ZLARHS -* - END diff --git a/testing/lin/zlarnd.f b/testing/lin/zlarnd.f deleted file mode 100644 index ed65e701e2780da5b07e15b4b29c7491677b625b..0000000000000000000000000000000000000000 --- a/testing/lin/zlarnd.f +++ /dev/null @@ -1,137 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE COMPLEX FUNCTION ZLARND( IDIST, ISEED ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) -* .. -* -* Purpose -* ======= -* -* ZLARND returns a random complex number from a uniform or normal -* distribution. -* -* Arguments -* ========= -* -* IDIST (input) INTEGER -* Specifies the distribution of the random numbers: -* = 1: real and imaginary parts each uniform (0,1) -* = 2: real and imaginary parts each uniform (-1,1) -* = 3: real and imaginary parts each normal (0,1) -* = 4: uniformly distributed on the disc abs(z) <= 1 -* = 5: uniformly distributed on the circle abs(z) = 1 -* -* ISEED (input/output) INTEGER array, dimension (4) -* On entry, the seed of the random number generator; the array -* elements must be between 0 and 4095, and ISEED(4) must be -* odd. -* On exit, the seed is updated. -* -* Further Details -* =============== -* -* This routine calls the auxiliary routine DLARAN to generate a random -* real number from a uniform (0,1) distribution. The Box-Muller method -* is used to transform numbers from a uniform to a normal distribution. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TWO - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 ) - DOUBLE PRECISION TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 ) -* .. -* .. Local Scalars .. - DOUBLE PRECISION T1, T2 -* .. -* .. External Functions .. - DOUBLE PRECISION DLARAN - EXTERNAL DLARAN -* .. -* .. Intrinsic Functions .. - INTRINSIC DCMPLX, EXP, LOG, SQRT -* .. -* .. Executable Statements .. -* -* Generate a pair of real random numbers from a uniform (0,1) -* distribution -* - T1 = DLARAN( ISEED ) - T2 = DLARAN( ISEED ) -* - IF( IDIST.EQ.1 ) THEN -* -* real and imaginary parts each uniform (0,1) -* - ZLARND = DCMPLX( T1, T2 ) - ELSE IF( IDIST.EQ.2 ) THEN -* -* real and imaginary parts each uniform (-1,1) -* - ZLARND = DCMPLX( TWO*T1-ONE, TWO*T2-ONE ) - ELSE IF( IDIST.EQ.3 ) THEN -* -* real and imaginary parts each normal (0,1) -* - ZLARND = SQRT( -TWO*LOG( T1 ) )*EXP( DCMPLX( ZERO, TWOPI*T2 ) ) - ELSE IF( IDIST.EQ.4 ) THEN -* -* uniform distribution on the unit disc abs(z) <= 1 -* - ZLARND = SQRT( T1 )*EXP( DCMPLX( ZERO, TWOPI*T2 ) ) - ELSE IF( IDIST.EQ.5 ) THEN -* -* uniform distribution on the unit circle abs(z) = 1 -* - ZLARND = EXP( DCMPLX( ZERO, TWOPI*T2 ) ) - END IF - RETURN -* -* End of ZLARND -* - END diff --git a/testing/lin/zlaror.f b/testing/lin/zlaror.f deleted file mode 100644 index 34af9c9bdaff2bfda63c82c3982f11e3c66c486b..0000000000000000000000000000000000000000 --- a/testing/lin/zlaror.f +++ /dev/null @@ -1,322 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER INIT, SIDE - INTEGER INFO, LDA, M, N -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX*16 A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* ZLAROR pre- or post-multiplies an M by N matrix A by a random -* unitary matrix U, overwriting A. A may optionally be -* initialized to the identity matrix before multiplying by U. -* U is generated using the method of G.W. Stewart -* ( SIAM J. Numer. Anal. 17, 1980, pp. 403-409 ). -* (BLAS-2 version) -* -* Arguments -* ========= -* -* SIDE - CHARACTER*1 -* SIDE specifies whether A is multiplied on the left or right -* by U. -* SIDE = 'L' Multiply A on the left (premultiply) by U -* SIDE = 'R' Multiply A on the right (postmultiply) by U* -* SIDE = 'C' Multiply A on the left by U and the right by U* -* SIDE = 'T' Multiply A on the left by U and the right by U' -* Not modified. -* -* INIT - CHARACTER*1 -* INIT specifies whether or not A should be initialized to -* the identity matrix. -* INIT = 'I' Initialize A to (a section of) the -* identity matrix before applying U. -* INIT = 'N' No initialization. Apply U to the -* input matrix A. -* -* INIT = 'I' may be used to generate square (i.e., unitary) -* or rectangular orthogonal matrices (orthogonality being -* in the sense of ZDOTC): -* -* For square matrices, M=N, and SIDE many be either 'L' or -* 'R'; the rows will be orthogonal to each other, as will the -* columns. -* For rectangular matrices where M < N, SIDE = 'R' will -* produce a dense matrix whose rows will be orthogonal and -* whose columns will not, while SIDE = 'L' will produce a -* matrix whose rows will be orthogonal, and whose first M -* columns will be orthogonal, the remaining columns being -* zero. -* For matrices where M > N, just use the previous -* explaination, interchanging 'L' and 'R' and "rows" and -* "columns". -* -* Not modified. -* -* M - INTEGER -* Number of rows of A. Not modified. -* -* N - INTEGER -* Number of columns of A. Not modified. -* -* A - COMPLEX*16 array, dimension ( LDA, N ) -* Input and output array. Overwritten by U A ( if SIDE = 'L' ) -* or by A U ( if SIDE = 'R' ) -* or by U A U* ( if SIDE = 'C') -* or by U A U' ( if SIDE = 'T') on exit. -* -* LDA - INTEGER -* Leading dimension of A. Must be at least MAX ( 1, M ). -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The array elements should be between 0 and 4095; -* if not they will be reduced mod 4096. Also, ISEED(4) must -* be odd. The random number generator uses a linear -* congruential sequence limited to small integers, and so -* should produce machine independent random numbers. The -* values of ISEED are changed on exit, and can be used in the -* next call to ZLAROR to continue the same random number -* sequence. -* Modified. -* -* X - COMPLEX*16 array, dimension ( 3*MAX( M, N ) ) -* Workspace. Of length: -* 2*M + N if SIDE = 'L', -* 2*N + M if SIDE = 'R', -* 3*N if SIDE = 'C' or 'T'. -* Modified. -* -* INFO - INTEGER -* An error flag. It is set to: -* 0 if no error. -* 1 if ZLARND returned a bad random number (installation -* problem) -* -1 if SIDE is not L, R, C, or T. -* -3 if M is negative. -* -4 if N is negative or if SIDE is C or T and N is not equal -* to M. -* -6 if LDA is less than M. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TOOSML - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, - $ TOOSML = 1.0D-20 ) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), - $ CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM - DOUBLE PRECISION FACTOR, XABS, XNORM - COMPLEX*16 CSIGN, XNORMS -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DZNRM2 - COMPLEX*16 ZLARND - EXTERNAL LSAME, DZNRM2, ZLARND -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGEMV, ZGERC, ZLACGV, ZLASET, ZSCAL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, DCONJG -* .. -* .. Executable Statements .. -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* - ITYPE = 0 - IF( LSAME( SIDE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( SIDE, 'R' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( SIDE, 'C' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( SIDE, 'T' ) ) THEN - ITYPE = 4 - END IF -* -* Check for argument errors. -* - INFO = 0 - IF( ITYPE.EQ.0 ) THEN - INFO = -1 - ELSE IF( M.LT.0 ) THEN - INFO = -3 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN - INFO = -4 - ELSE IF( LDA.LT.M ) THEN - INFO = -6 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLAROR', -INFO ) - RETURN - END IF -* - IF( ITYPE.EQ.1 ) THEN - NXFRM = M - ELSE - NXFRM = N - END IF -* -* Initialize A to the identity matrix if desired -* - IF( LSAME( INIT, 'I' ) ) - $ CALL ZLASET( 'Full', M, N, CZERO, CONE, A, LDA ) -* -* If no rotation possible, still multiply by -* a random complex number from the circle |x| = 1 -* -* 2) Compute Rotation by computing Householder -* Transformations H(2), H(3), ..., H(n). Note that the -* order in which they are computed is irrelevant. -* - DO 10 J = 1, NXFRM - X( J ) = CZERO - 10 CONTINUE -* - DO 30 IXFRM = 2, NXFRM - KBEG = NXFRM - IXFRM + 1 -* -* Generate independent normal( 0, 1 ) random numbers -* - DO 20 J = KBEG, NXFRM - X( J ) = ZLARND( 3, ISEED ) - 20 CONTINUE -* -* Generate a Householder transformation from the random vector X -* - XNORM = DZNRM2( IXFRM, X( KBEG ), 1 ) - XABS = ABS( X( KBEG ) ) - IF( XABS.NE.CZERO ) THEN - CSIGN = X( KBEG ) / XABS - ELSE - CSIGN = CONE - END IF - XNORMS = CSIGN*XNORM - X( NXFRM+KBEG ) = -CSIGN - FACTOR = XNORM*( XNORM+XABS ) - IF( ABS( FACTOR ).LT.TOOSML ) THEN - INFO = 1 - CALL XERBLA( 'ZLAROR', -INFO ) - RETURN - ELSE - FACTOR = ONE / FACTOR - END IF - X( KBEG ) = X( KBEG ) + XNORMS -* -* Apply Householder transformation to A -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN -* -* Apply H(k) on the left of A -* - CALL ZGEMV( 'C', IXFRM, N, CONE, A( KBEG, 1 ), LDA, - $ X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 ) - CALL ZGERC( IXFRM, N, -DCMPLX( FACTOR ), X( KBEG ), 1, - $ X( 2*NXFRM+1 ), 1, A( KBEG, 1 ), LDA ) -* - END IF -* - IF( ITYPE.GE.2 .AND. ITYPE.LE.4 ) THEN -* -* Apply H(k)* (or H(k)') on the right of A -* - IF( ITYPE.EQ.4 ) THEN - CALL ZLACGV( IXFRM, X( KBEG ), 1 ) - END IF -* - CALL ZGEMV( 'N', M, IXFRM, CONE, A( 1, KBEG ), LDA, - $ X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 ) - CALL ZGERC( M, IXFRM, -DCMPLX( FACTOR ), X( 2*NXFRM+1 ), 1, - $ X( KBEG ), 1, A( 1, KBEG ), LDA ) -* - END IF - 30 CONTINUE -* - X( 1 ) = ZLARND( 3, ISEED ) - XABS = ABS( X( 1 ) ) - IF( XABS.NE.ZERO ) THEN - CSIGN = X( 1 ) / XABS - ELSE - CSIGN = CONE - END IF - X( 2*NXFRM ) = CSIGN -* -* Scale the matrix A by D. -* - IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN - DO 40 IROW = 1, M - CALL ZSCAL( N, DCONJG( X( NXFRM+IROW ) ), A( IROW, 1 ), - $ LDA ) - 40 CONTINUE - END IF -* - IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN - DO 50 JCOL = 1, N - CALL ZSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 ) - 50 CONTINUE - END IF -* - IF( ITYPE.EQ.4 ) THEN - DO 60 JCOL = 1, N - CALL ZSCAL( M, DCONJG( X( NXFRM+JCOL ) ), A( 1, JCOL ), 1 ) - 60 CONTINUE - END IF - RETURN -* -* End of ZLAROR -* - END diff --git a/testing/lin/zlarot.f b/testing/lin/zlarot.f deleted file mode 100644 index c5bbfef289ad482fdb383c832f48fa1a3a4c9cb0..0000000000000000000000000000000000000000 --- a/testing/lin/zlarot.f +++ /dev/null @@ -1,333 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, - $ XRIGHT ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - LOGICAL LLEFT, LRIGHT, LROWS - INTEGER LDA, NL - COMPLEX*16 C, S, XLEFT, XRIGHT -* .. -* .. Array Arguments .. - COMPLEX*16 A( * ) -* .. -* -* Purpose -* ======= -* -* ZLAROT applies a (Givens) rotation to two adjacent rows or -* columns, where one element of the first and/or last column/row -* for use on matrices stored in some format other than GE, so -* that elements of the matrix may be used or modified for which -* no array element is provided. -* -* One example is a symmetric matrix in SB format (bandwidth=4), for -* which UPLO='L': Two adjacent rows will have the format: -* -* row j: * * * * * . . . . -* row j+1: * * * * * . . . . -* -* '*' indicates elements for which storage is provided, -* '.' indicates elements for which no storage is provided, but -* are not necessarily zero; their values are determined by -* symmetry. ' ' indicates elements which are necessarily zero, -* and have no storage provided. -* -* Those columns which have two '*'s can be handled by DROT. -* Those columns which have no '*'s can be ignored, since as long -* as the Givens rotations are carefully applied to preserve -* symmetry, their values are determined. -* Those columns which have one '*' have to be handled separately, -* by using separate variables "p" and "q": -* -* row j: * * * * * p . . . -* row j+1: q * * * * * . . . . -* -* The element p would have to be set correctly, then that column -* is rotated, setting p to its new value. The next call to -* ZLAROT would rotate columns j and j+1, using p, and restore -* symmetry. The element q would start out being zero, and be -* made non-zero by the rotation. Later, rotations would presumably -* be chosen to zero q out. -* -* Typical Calling Sequences: rotating the i-th and (i+1)-st rows. -* ------- ------- --------- -* -* General dense matrix: -* -* CALL ZLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, -* A(i,1),LDA, DUMMY, DUMMY) -* -* General banded matrix in GB format: -* -* j = MAX(1, i-KL ) -* NL = MIN( N, i+KU+1 ) + 1-j -* CALL ZLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, -* A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,KL+1) ] -* -* Symmetric banded matrix in SY format, bandwidth K, -* lower triangle only: -* -* j = MAX(1, i-K ) -* NL = MIN( K+1, i ) + 1 -* CALL ZLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, -* A(i,j), LDA, XLEFT, XRIGHT ) -* -* Same, but upper triangle only: -* -* NL = MIN( K+1, N-i ) + 1 -* CALL ZLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, -* A(i,i), LDA, XLEFT, XRIGHT ) -* -* Symmetric banded matrix in SB format, bandwidth K, -* lower triangle only: -* -* [ same as for SY, except:] -* . . . . -* A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) -* -* [ note that i+1-j is just MIN(i,K+1) ] -* -* Same, but upper triangle only: -* . . . -* A(K+1,i), LDA-1, XLEFT, XRIGHT ) -* -* Rotating columns is just the transpose of rotating rows, except -* for GB and SB: (rotating columns i and i+1) -* -* GB: -* j = MAX(1, i-KU ) -* NL = MIN( N, i+KL+1 ) + 1-j -* CALL ZLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, -* A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* [note that KU+j+1-i is just MAX(1,KU+2-i)] -* -* SB: (upper triangle) -* -* . . . . . . -* A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) -* -* SB: (lower triangle) -* -* . . . . . . -* A(1,i),LDA-1, XTOP, XBOTTM ) -* -* Arguments -* ========= -* -* LROWS - LOGICAL -* If .TRUE., then ZLAROT will rotate two rows. If .FALSE., -* then it will rotate two columns. -* Not modified. -* -* LLEFT - LOGICAL -* If .TRUE., then XLEFT will be used instead of the -* corresponding element of A for the first element in the -* second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) -* If .FALSE., then the corresponding element of A will be -* used. -* Not modified. -* -* LRIGHT - LOGICAL -* If .TRUE., then XRIGHT will be used instead of the -* corresponding element of A for the last element in the -* first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If -* .FALSE., then the corresponding element of A will be used. -* Not modified. -* -* NL - INTEGER -* The length of the rows (if LROWS=.TRUE.) or columns (if -* LROWS=.FALSE.) to be rotated. If XLEFT and/or XRIGHT are -* used, the columns/rows they are in should be included in -* NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at -* least 2. The number of rows/columns to be rotated -* exclusive of those involving XLEFT and/or XRIGHT may -* not be negative, i.e., NL minus how many of LLEFT and -* LRIGHT are .TRUE. must be at least zero; if not, XERBLA -* will be called. -* Not modified. -* -* C, S - COMPLEX*16 -* Specify the Givens rotation to be applied. If LROWS is -* true, then the matrix ( c s ) -* ( _ _ ) -* (-s c ) is applied from the left; -* if false, then the transpose (not conjugated) thereof is -* applied from the right. Note that in contrast to the -* output of ZROTG or to most versions of ZROT, both C and S -* are complex. For a Givens rotation, |C|**2 + |S|**2 should -* be 1, but this is not checked. -* Not modified. -* -* A - COMPLEX*16 array. -* The array containing the rows/columns to be rotated. The -* first element of A should be the upper left element to -* be rotated. -* Read and modified. -* -* LDA - INTEGER -* The "effective" leading dimension of A. If A contains -* a matrix stored in GE, HE, or SY format, then this is just -* the leading dimension of A as dimensioned in the calling -* routine. If A contains a matrix stored in band (GB, HB, or -* SB) format, then this should be *one less* than the leading -* dimension used in the calling routine. Thus, if A were -* dimensioned A(LDA,*) in ZLAROT, then A(1,j) would be the -* j-th element in the first of the two rows to be rotated, -* and A(2,j) would be the j-th in the second, regardless of -* how the array may be stored in the calling routine. [A -* cannot, however, actually be dimensioned thus, since for -* band format, the row number may exceed LDA, which is not -* legal FORTRAN.] -* If LROWS=.TRUE., then LDA must be at least 1, otherwise -* it must be at least NL minus the number of .TRUE. values -* in XLEFT and XRIGHT. -* Not modified. -* -* XLEFT - COMPLEX*16 -* If LLEFT is .TRUE., then XLEFT will be used and modified -* instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) -* (if LROWS=.FALSE.). -* Read and modified. -* -* XRIGHT - COMPLEX*16 -* If LRIGHT is .TRUE., then XRIGHT will be used and modified -* instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) -* (if LROWS=.FALSE.). -* Read and modified. -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER IINC, INEXT, IX, IY, IYT, J, NT - COMPLEX*16 TEMPX -* .. -* .. Local Arrays .. - COMPLEX*16 XT( 2 ), YT( 2 ) -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC DCONJG -* .. -* .. Executable Statements .. -* -* Set up indices, arrays for ends -* - IF( LROWS ) THEN - IINC = LDA - INEXT = 1 - ELSE - IINC = 1 - INEXT = LDA - END IF -* - IF( LLEFT ) THEN - NT = 1 - IX = 1 + IINC - IY = 2 + LDA - XT( 1 ) = A( 1 ) - YT( 1 ) = XLEFT - ELSE - NT = 0 - IX = 1 - IY = 1 + INEXT - END IF -* - IF( LRIGHT ) THEN - IYT = 1 + INEXT + ( NL-1 )*IINC - NT = NT + 1 - XT( NT ) = XRIGHT - YT( NT ) = A( IYT ) - END IF -* -* Check for errors -* - IF( NL.LT.NT ) THEN - CALL XERBLA( 'ZLAROT', 4 ) - RETURN - END IF - IF( LDA.LE.0 .OR. ( .NOT.LROWS .AND. LDA.LT.NL-NT ) ) THEN - CALL XERBLA( 'ZLAROT', 8 ) - RETURN - END IF -* -* Rotate -* -* ZROT( NL-NT, A(IX),IINC, A(IY),IINC, C, S ) with complex C, S -* - DO 10 J = 0, NL - NT - 1 - TEMPX = C*A( IX+J*IINC ) + S*A( IY+J*IINC ) - A( IY+J*IINC ) = -DCONJG( S )*A( IX+J*IINC ) + - $ DCONJG( C )*A( IY+J*IINC ) - A( IX+J*IINC ) = TEMPX - 10 CONTINUE -* -* ZROT( NT, XT,1, YT,1, C, S ) with complex C, S -* - DO 20 J = 1, NT - TEMPX = C*XT( J ) + S*YT( J ) - YT( J ) = -DCONJG( S )*XT( J ) + DCONJG( C )*YT( J ) - XT( J ) = TEMPX - 20 CONTINUE -* -* Stuff values back into XLEFT, XRIGHT, etc. -* - IF( LLEFT ) THEN - A( 1 ) = XT( 1 ) - XLEFT = YT( 1 ) - END IF -* - IF( LRIGHT ) THEN - XRIGHT = XT( NT ) - A( IYT ) = YT( NT ) - END IF -* - RETURN -* -* End of ZLAROT -* - END diff --git a/testing/lin/zlartg.f b/testing/lin/zlartg.f deleted file mode 100644 index 07b1e53b7b67ff3eb094b2c42152f87f8ab51f66..0000000000000000000000000000000000000000 --- a/testing/lin/zlartg.f +++ /dev/null @@ -1,232 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLARTG( F, G, CS, SN, R ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - DOUBLE PRECISION CS - COMPLEX*16 F, G, R, SN -* .. -* -* Purpose -* ======= -* -* ZLARTG generates a plane rotation so that -* -* [ CS SN ] [ F ] [ R ] -* [ __ ] . [ ] = [ ] where CS**2 + |SN|**2 = 1. -* [ -SN CS ] [ G ] [ 0 ] -* -* This is a faster version of the BLAS1 routine ZROTG, except for -* the following differences: -* F and G are unchanged on return. -* If G=0, then CS=1 and SN=0. -* If F=0, then CS=0 and SN is chosen so that R is real. -* -* Arguments -* ========= -* -* F (input) COMPLEX*16 -* The first component of vector to be rotated. -* -* G (input) COMPLEX*16 -* The second component of vector to be rotated. -* -* CS (output) DOUBLE PRECISION -* The cosine of the rotation. -* -* SN (output) COMPLEX*16 -* The sine of the rotation. -* -* R (output) COMPLEX*16 -* The nonzero component of the rotated vector. -* -* Further Details -* ======= ======= -* -* 3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel -* -* This version has a few statements commented out for thread safety -* (machine parameters are computed on each entry). 10 feb 03, SJH. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION TWO, ONE, ZERO - PARAMETER ( TWO = 2.0D+0, ONE = 1.0D+0, ZERO = 0.0D+0 ) - COMPLEX*16 CZERO - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. -* LOGICAL FIRST - INTEGER COUNT, I - DOUBLE PRECISION D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN, - $ SAFMN2, SAFMX2, SCALE - COMPLEX*16 FF, FS, GS -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DLAPY2 - EXTERNAL DLAMCH, DLAPY2 -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, LOG, - $ MAX, SQRT -* .. -* .. Statement Functions .. - DOUBLE PRECISION ABS1, ABSSQ -* .. -* .. Save statement .. -* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2 -* .. -* .. Data statements .. -* DATA FIRST / .TRUE. / -* .. -* .. Statement Function definitions .. - ABS1( FF ) = MAX( ABS( DBLE( FF ) ), ABS( DIMAG( FF ) ) ) - ABSSQ( FF ) = DBLE( FF )**2 + DIMAG( FF )**2 -* .. -* .. Executable Statements .. -* -* IF( FIRST ) THEN - SAFMIN = DLAMCH( 'S' ) - EPS = DLAMCH( 'E' ) - SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) / - $ LOG( DLAMCH( 'B' ) ) / TWO ) - SAFMX2 = ONE / SAFMN2 -* FIRST = .FALSE. -* END IF - SCALE = MAX( ABS1( F ), ABS1( G ) ) - FS = F - GS = G - COUNT = 0 - IF( SCALE.GE.SAFMX2 ) THEN - 10 CONTINUE - COUNT = COUNT + 1 - FS = FS*SAFMN2 - GS = GS*SAFMN2 - SCALE = SCALE*SAFMN2 - IF( SCALE.GE.SAFMX2 ) - $ GO TO 10 - ELSE IF( SCALE.LE.SAFMN2 ) THEN - IF( G.EQ.CZERO ) THEN - CS = ONE - SN = CZERO - R = F - RETURN - END IF - 20 CONTINUE - COUNT = COUNT - 1 - FS = FS*SAFMX2 - GS = GS*SAFMX2 - SCALE = SCALE*SAFMX2 - IF( SCALE.LE.SAFMN2 ) - $ GO TO 20 - END IF - F2 = ABSSQ( FS ) - G2 = ABSSQ( GS ) - IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN -* -* This is a rare case: F is very small. -* - IF( F.EQ.CZERO ) THEN - CS = ZERO - R = DLAPY2( DBLE( G ), DIMAG( G ) ) -* Do complex/real division explicitly with two real divisions - D = DLAPY2( DBLE( GS ), DIMAG( GS ) ) - SN = DCMPLX( DBLE( GS ) / D, -DIMAG( GS ) / D ) - RETURN - END IF - F2S = DLAPY2( DBLE( FS ), DIMAG( FS ) ) -* G2 and G2S are accurate -* G2 is at least SAFMIN, and G2S is at least SAFMN2 - G2S = SQRT( G2 ) -* Error in CS from underflow in F2S is at most -* UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS -* If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN, -* and so CS .lt. sqrt(SAFMIN) -* If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN -* and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS) -* Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S - CS = F2S / G2S -* Make sure abs(FF) = 1 -* Do complex/real division explicitly with 2 real divisions - IF( ABS1( F ).GT.ONE ) THEN - D = DLAPY2( DBLE( F ), DIMAG( F ) ) - FF = DCMPLX( DBLE( F ) / D, DIMAG( F ) / D ) - ELSE - DR = SAFMX2*DBLE( F ) - DI = SAFMX2*DIMAG( F ) - D = DLAPY2( DR, DI ) - FF = DCMPLX( DR / D, DI / D ) - END IF - SN = FF*DCMPLX( DBLE( GS ) / G2S, -DIMAG( GS ) / G2S ) - R = CS*F + SN*G - ELSE -* -* This is the most common case. -* Neither F2 nor F2/G2 are less than SAFMIN -* F2S cannot overflow, and it is accurate -* - F2S = SQRT( ONE+G2 / F2 ) -* Do the F2S(real)*FS(complex) multiply with two real multiplies - R = DCMPLX( F2S*DBLE( FS ), F2S*DIMAG( FS ) ) - CS = ONE / F2S - D = F2 + G2 -* Do complex/real division explicitly with two real divisions - SN = DCMPLX( DBLE( R ) / D, DIMAG( R ) / D ) - SN = SN*DCONJG( GS ) - IF( COUNT.NE.0 ) THEN - IF( COUNT.GT.0 ) THEN - DO 30 I = 1, COUNT - R = R*SAFMX2 - 30 CONTINUE - ELSE - DO 40 I = 1, -COUNT - R = R*SAFMN2 - 40 CONTINUE - END IF - END IF - END IF - RETURN -* -* End of ZLARTG -* - END diff --git a/testing/lin/zlascl.f b/testing/lin/zlascl.f deleted file mode 100644 index cd539de29efe0cf6cc299b04ac01dbb0394bcf56..0000000000000000000000000000000000000000 --- a/testing/lin/zlascl.f +++ /dev/null @@ -1,320 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TYPE - INTEGER INFO, KL, KU, LDA, M, N - DOUBLE PRECISION CFROM, CTO -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLASCL multiplies the M by N complex matrix A by the real scalar -* CTO/CFROM. This is done without over/underflow as long as the final -* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that -* A may be full, upper triangular, lower triangular, upper Hessenberg, -* or banded. -* -* Arguments -* ========= -* -* TYPE (input) CHARACTER*1 -* TYPE indices the storage type of the input matrix. -* = 'G': A is a full matrix. -* = 'L': A is a lower triangular matrix. -* = 'U': A is an upper triangular matrix. -* = 'H': A is an upper Hessenberg matrix. -* = 'B': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the lower -* half stored. -* = 'Q': A is a symmetric band matrix with lower bandwidth KL -* and upper bandwidth KU and with the only the upper -* half stored. -* = 'Z': A is a band matrix with lower bandwidth KL and upper -* bandwidth KU. -* -* KL (input) INTEGER -* The lower bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* KU (input) INTEGER -* The upper bandwidth of A. Referenced only if TYPE = 'B', -* 'Q' or 'Z'. -* -* CFROM (input) DOUBLE PRECISION -* CTO (input) DOUBLE PRECISION -* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed -* without over/underflow if the final result CTO*A(I,J)/CFROM -* can be represented without over/underflow. CFROM must be -* nonzero. -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* The matrix to be multiplied by CTO/CFROM. See TYPE for the -* storage type. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* INFO (output) INTEGER -* 0 - successful exit -* <0 - if INFO = -i, the i-th argument had an illegal value. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - LOGICAL DONE - INTEGER I, ITYPE, J, K1, K2, K3, K4 - DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME, DISNAN - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH, DISNAN -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input arguments -* - INFO = 0 -* - IF( LSAME( TYPE, 'G' ) ) THEN - ITYPE = 0 - ELSE IF( LSAME( TYPE, 'L' ) ) THEN - ITYPE = 1 - ELSE IF( LSAME( TYPE, 'U' ) ) THEN - ITYPE = 2 - ELSE IF( LSAME( TYPE, 'H' ) ) THEN - ITYPE = 3 - ELSE IF( LSAME( TYPE, 'B' ) ) THEN - ITYPE = 4 - ELSE IF( LSAME( TYPE, 'Q' ) ) THEN - ITYPE = 5 - ELSE IF( LSAME( TYPE, 'Z' ) ) THEN - ITYPE = 6 - ELSE - ITYPE = -1 - END IF -* - IF( ITYPE.EQ.-1 ) THEN - INFO = -1 - ELSE IF( CFROM.EQ.ZERO .OR. DISNAN(CFROM) ) THEN - INFO = -4 - ELSE IF( DISNAN(CTO) ) THEN - INFO = -5 - ELSE IF( M.LT.0 ) THEN - INFO = -6 - ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR. - $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN - INFO = -7 - ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN - INFO = -9 - ELSE IF( ITYPE.GE.4 ) THEN - IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN - INFO = -2 - ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR. - $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) ) - $ THEN - INFO = -3 - ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR. - $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR. - $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN - INFO = -9 - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLASCL', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. M.EQ.0 ) - $ RETURN -* -* Get machine parameters -* - SMLNUM = DLAMCH( 'S' ) - BIGNUM = ONE / SMLNUM -* - CFROMC = CFROM - CTOC = CTO -* - 10 CONTINUE - CFROM1 = CFROMC*SMLNUM - IF( CFROM1.EQ.CFROMC ) THEN -! CFROMC is an inf. Multiply by a correctly signed zero for -! finite CTOC, or a NaN if CTOC is infinite. - MUL = CTOC / CFROMC - DONE = .TRUE. - CTO1 = CTOC - ELSE - CTO1 = CTOC / BIGNUM - IF( CTO1.EQ.CTOC ) THEN -! CTOC is either 0 or an inf. In both cases, CTOC itself -! serves as the correct multiplication factor. - MUL = CTOC - DONE = .TRUE. - CFROMC = ONE - ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN - MUL = SMLNUM - DONE = .FALSE. - CFROMC = CFROM1 - ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN - MUL = BIGNUM - DONE = .FALSE. - CTOC = CTO1 - ELSE - MUL = CTOC / CFROMC - DONE = .TRUE. - END IF - END IF -* - IF( ITYPE.EQ.0 ) THEN -* -* Full matrix -* - DO 30 J = 1, N - DO 20 I = 1, M - A( I, J ) = A( I, J )*MUL - 20 CONTINUE - 30 CONTINUE -* - ELSE IF( ITYPE.EQ.1 ) THEN -* -* Lower triangular matrix -* - DO 50 J = 1, N - DO 40 I = J, M - A( I, J ) = A( I, J )*MUL - 40 CONTINUE - 50 CONTINUE -* - ELSE IF( ITYPE.EQ.2 ) THEN -* -* Upper triangular matrix -* - DO 70 J = 1, N - DO 60 I = 1, MIN( J, M ) - A( I, J ) = A( I, J )*MUL - 60 CONTINUE - 70 CONTINUE -* - ELSE IF( ITYPE.EQ.3 ) THEN -* -* Upper Hessenberg matrix -* - DO 90 J = 1, N - DO 80 I = 1, MIN( J+1, M ) - A( I, J ) = A( I, J )*MUL - 80 CONTINUE - 90 CONTINUE -* - ELSE IF( ITYPE.EQ.4 ) THEN -* -* Lower half of a symmetric band matrix -* - K3 = KL + 1 - K4 = N + 1 - DO 110 J = 1, N - DO 100 I = 1, MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 100 CONTINUE - 110 CONTINUE -* - ELSE IF( ITYPE.EQ.5 ) THEN -* -* Upper half of a symmetric band matrix -* - K1 = KU + 2 - K3 = KU + 1 - DO 130 J = 1, N - DO 120 I = MAX( K1-J, 1 ), K3 - A( I, J ) = A( I, J )*MUL - 120 CONTINUE - 130 CONTINUE -* - ELSE IF( ITYPE.EQ.6 ) THEN -* -* Band matrix -* - K1 = KL + KU + 2 - K2 = KL + 1 - K3 = 2*KL + KU + 1 - K4 = KL + KU + 1 + M - DO 150 J = 1, N - DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J ) - A( I, J ) = A( I, J )*MUL - 140 CONTINUE - 150 CONTINUE -* - END IF -* - IF( .NOT.DONE ) - $ GO TO 10 -* - RETURN -* -* End of ZLASCL -* - END diff --git a/testing/lin/zlaset.f b/testing/lin/zlaset.f deleted file mode 100644 index 9f8fe4f8d768cd31782701a88573351f98f729a3..0000000000000000000000000000000000000000 --- a/testing/lin/zlaset.f +++ /dev/null @@ -1,151 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, M, N - COMPLEX*16 ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLASET initializes a 2-D array A to BETA on the diagonal and -* ALPHA on the offdiagonals. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies the part of the matrix A to be set. -* = 'U': Upper triangular part is set. The lower triangle -* is unchanged. -* = 'L': Lower triangular part is set. The upper triangle -* is unchanged. -* Otherwise: All of the matrix A is set. -* -* M (input) INTEGER -* On entry, M specifies the number of rows of A. -* -* N (input) INTEGER -* On entry, N specifies the number of columns of A. -* -* ALPHA (input) COMPLEX*16 -* All the offdiagonal array elements are set to ALPHA. -* -* BETA (input) COMPLEX*16 -* All the diagonal array elements are set to BETA. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the m by n matrix A. -* On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j; -* A(i,i) = BETA , 1 <= i <= min(m,n) -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* ===================================================================== -* -* .. Local Scalars .. - INTEGER I, J -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Intrinsic Functions .. - INTRINSIC MIN -* .. -* .. Executable Statements .. -* - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Set the diagonal to BETA and the strictly upper triangular -* part of the array to ALPHA. -* - DO 20 J = 2, N - DO 10 I = 1, MIN( J-1, M ) - A( I, J ) = ALPHA - 10 CONTINUE - 20 CONTINUE - DO 30 I = 1, MIN( N, M ) - A( I, I ) = BETA - 30 CONTINUE -* - ELSE IF( LSAME( UPLO, 'L' ) ) THEN -* -* Set the diagonal to BETA and the strictly lower triangular -* part of the array to ALPHA. -* - DO 50 J = 1, MIN( M, N ) - DO 40 I = J + 1, M - A( I, J ) = ALPHA - 40 CONTINUE - 50 CONTINUE - DO 60 I = 1, MIN( N, M ) - A( I, I ) = BETA - 60 CONTINUE -* - ELSE -* -* Set the array to BETA on the diagonal and ALPHA on the -* offdiagonal. -* - DO 80 J = 1, N - DO 70 I = 1, M - A( I, J ) = ALPHA - 70 CONTINUE - 80 CONTINUE - DO 90 I = 1, MIN( M, N ) - A( I, I ) = BETA - 90 CONTINUE - END IF -* - RETURN -* -* End of ZLASET -* - END diff --git a/testing/lin/zlatb4.f b/testing/lin/zlatb4.f deleted file mode 100644 index 073872d8643bab9d4f74f6dc82aa660ab150a9a5..0000000000000000000000000000000000000000 --- a/testing/lin/zlatb4.f +++ /dev/null @@ -1,476 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, - $ CNDNUM, DIST ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, TYPE - CHARACTER*3 PATH - INTEGER IMAT, KL, KU, M, MODE, N - DOUBLE PRECISION ANORM, CNDNUM -* .. -* -* Purpose -* ======= -* -* ZLATB4 sets parameters for the matrix generator based on the type of -* matrix to be generated. -* -* Arguments -* ========= -* -* PATH (input) CHARACTER*3 -* The LAPACK path name. -* -* IMAT (input) INTEGER -* An integer key describing which matrix to generate for this -* path. -* -* M (input) INTEGER -* The number of rows in the matrix to be generated. -* -* N (input) INTEGER -* The number of columns in the matrix to be generated. -* -* TYPE (output) CHARACTER*1 -* The type of the matrix to be generated: -* = 'S': symmetric matrix -* = 'P': symmetric positive (semi)definite matrix -* = 'N': nonsymmetric matrix -* -* KL (output) INTEGER -* The lower band width of the matrix to be generated. -* -* KU (output) INTEGER -* The upper band width of the matrix to be generated. -* -* ANORM (output) DOUBLE PRECISION -* The desired norm of the matrix to be generated. The diagonal -* matrix of singular values or eigenvalues is scaled by this -* value. -* -* MODE (output) INTEGER -* A key indicating how to choose the vector of eigenvalues. -* -* CNDNUM (output) DOUBLE PRECISION -* The desired condition number. -* -* DIST (output) CHARACTER*1 -* The type of distribution to be used by the random number -* generator. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION SHRINK, TENTH - PARAMETER ( SHRINK = 0.25D0, TENTH = 0.1D+0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL FIRST - CHARACTER*2 C2 - INTEGER MAT - DOUBLE PRECISION BADC1, BADC2, EPS, LARGE, SMALL -* .. -* .. External Functions .. - LOGICAL LSAMEN - DOUBLE PRECISION DLAMCH - EXTERNAL LSAMEN, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT -* .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. -* .. Save statement .. - SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST -* .. -* .. Data statements .. - DATA FIRST / .TRUE. / -* .. -* .. Executable Statements .. -* -* Set some constants for use in the subroutine. -* - IF( FIRST ) THEN - FIRST = .FALSE. - EPS = DLAMCH( 'Precision' ) - BADC2 = TENTH / EPS - BADC1 = SQRT( BADC2 ) - SMALL = DLAMCH( 'Safe minimum' ) - LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) - SMALL = SHRINK*( SMALL / EPS ) - LARGE = ONE / SMALL - END IF -* - C2 = PATH( 2: 3 ) -* -* Set some parameters we don't plan to change. -* - DIST = 'S' - MODE = 3 -* -* xQR, xLQ, xQL, xRQ: Set parameters to generate a general -* M x N matrix. -* - IF( LSAMEN( 2, C2, 'QR' ) .OR. LSAMEN( 2, C2, 'LQ' ) .OR. - $ LSAMEN( 2, C2, 'QL' ) .OR. LSAMEN( 2, C2, 'RQ' ) ) THEN -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN -* -* xGE: Set parameters to generate a general M x N matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.EQ.2 ) THEN - KL = 0 - KU = MAX( N-1, 0 ) - ELSE IF( IMAT.EQ.3 ) THEN - KL = MAX( M-1, 0 ) - KU = 0 - ELSE - KL = MAX( M-1, 0 ) - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.10 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.11 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN -* -* xGB: Set parameters to generate a general banded matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the condition number and norm. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = TENTH*BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN -* -* xGT: Set parameters to generate a general tridiagonal matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) .OR. - $ LSAMEN( 2, C2, 'HE' ) .OR. LSAMEN( 2, C2, 'HP' ) .OR. - $ LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN -* -* xPO, xPP, xHE, xHP, xSY, xSP: Set parameters to generate a -* symmetric or Hermitian matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = C2( 1: 1 ) -* -* Set the lower and upper bandwidths. -* - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = MAX( N-1, 0 ) - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.7 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.8 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.9 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN -* -* xPB: Set parameters to generate a symmetric band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'P' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.5 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.6 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.7 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.8 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN -* -* xPT: Set parameters to generate a symmetric positive definite -* tridiagonal matrix. -* - TYPE = 'P' - IF( IMAT.EQ.1 ) THEN - KL = 0 - ELSE - KL = 1 - END IF - KU = KL -* -* Set the condition number and norm. -* - IF( IMAT.EQ.3 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.4 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.5 .OR. IMAT.EQ.11 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.6 .OR. IMAT.EQ.12 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN -* -* xTR, xTP: Set parameters to generate a triangular matrix -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the lower and upper bandwidths. -* - MAT = ABS( IMAT ) - IF( MAT.EQ.1 .OR. MAT.EQ.7 ) THEN - KL = 0 - KU = 0 - ELSE IF( IMAT.LT.0 ) THEN - KL = MAX( N-1, 0 ) - KU = 0 - ELSE - KL = 0 - KU = MAX( N-1, 0 ) - END IF -* -* Set the condition number and norm. -* - IF( MAT.EQ.3 .OR. MAT.EQ.9 ) THEN - CNDNUM = BADC1 - ELSE IF( MAT.EQ.4 .OR. MAT.EQ.10 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( MAT.EQ.5 ) THEN - ANORM = SMALL - ELSE IF( MAT.EQ.6 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF -* - ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN -* -* xTB: Set parameters to generate a triangular band matrix. -* -* Set TYPE, the type of matrix to be generated. -* - TYPE = 'N' -* -* Set the norm and condition number. -* - IF( IMAT.EQ.2 .OR. IMAT.EQ.8 ) THEN - CNDNUM = BADC1 - ELSE IF( IMAT.EQ.3 .OR. IMAT.EQ.9 ) THEN - CNDNUM = BADC2 - ELSE - CNDNUM = TWO - END IF -* - IF( IMAT.EQ.4 ) THEN - ANORM = SMALL - ELSE IF( IMAT.EQ.5 ) THEN - ANORM = LARGE - ELSE - ANORM = ONE - END IF - END IF - IF( N.LE.1 ) - $ CNDNUM = ONE -* - RETURN -* -* End of ZLATB4 -* - END diff --git a/testing/lin/zlatm1.f b/testing/lin/zlatm1.f deleted file mode 100644 index aaa088d1d6a850023cfe0f1593736e47d928e239..0000000000000000000000000000000000000000 --- a/testing/lin/zlatm1.f +++ /dev/null @@ -1,274 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) -* -* -- LAPACK auxiliary test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER IDIST, INFO, IRSIGN, MODE, N - DOUBLE PRECISION COND -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX*16 D( * ) -* .. -* -* Purpose -* ======= -* -* ZLATM1 computes the entries of D(1..N) as specified by -* MODE, COND and IRSIGN. IDIST and ISEED determine the generation -* of random numbers. ZLATM1 is called by CLATMR to generate -* random test matrices for LAPACK programs. -* -* Arguments -* ========= -* -* MODE - INTEGER -* On entry describes how D is to be computed: -* MODE = 0 means do not change D. -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* Not modified. -* -* COND - DOUBLE PRECISION -* On entry, used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* IRSIGN - INTEGER -* On entry, if MODE neither -6, 0 nor 6, determines sign of -* entries of D -* 0 => leave entries of D unchanged -* 1 => multiply each entry of D by random complex number -* uniformly distributed with absolute value 1 -* -* IDIST - CHARACTER*1 -* On entry, IDIST specifies the type of distribution to be -* used to generate a random matrix . -* 1 => real and imaginary parts each UNIFORM( 0, 1 ) -* 2 => real and imaginary parts each UNIFORM( -1, 1 ) -* 3 => real and imaginary parts each NORMAL( 0, 1 ) -* 4 => complex number uniform in DISK( 0, 1 ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. The random number generator uses a -* linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to ZLATM1 -* to continue the same random number sequence. -* Changed on exit. -* -* D - COMPLEX*16 array, dimension ( MIN( M , N ) ) -* Array to be computed according to MODE, COND and IRSIGN. -* May be changed on exit if MODE is nonzero. -* -* N - INTEGER -* Number of entries of D. Not modified. -* -* INFO - INTEGER -* 0 => normal termination -* -1 => if MODE not in range -6 to 6 -* -2 => if MODE neither -6, 0 nor 6, and -* IRSIGN neither 0 nor 1 -* -3 => if MODE neither -6, 0 nor 6 and COND less than 1 -* -4 => if MODE equals 6 or -6 and IDIST not in range 1 to 4 -* -7 => if N negative -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - INTEGER I - DOUBLE PRECISION ALPHA, TEMP - COMPLEX*16 CTEMP -* .. -* .. External Functions .. - DOUBLE PRECISION DLARAN - COMPLEX*16 ZLARND - EXTERNAL DLARAN, ZLARND -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZLARNV -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, EXP, LOG -* .. -* .. Executable Statements .. -* -* Decode and Test the input parameters. Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Set INFO if an error -* - IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN - INFO = -1 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN - INFO = -2 - ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ COND.LT.ONE ) THEN - INFO = -3 - ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND. - $ ( IDIST.LT.1 .OR. IDIST.GT.4 ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -7 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLATM1', -INFO ) - RETURN - END IF -* -* Compute D according to COND and MODE -* - IF( MODE.NE.0 ) THEN - GO TO ( 10, 30, 50, 70, 90, 110 )ABS( MODE ) -* -* One large D value: -* - 10 CONTINUE - DO 20 I = 1, N - D( I ) = ONE / COND - 20 CONTINUE - D( 1 ) = ONE - GO TO 120 -* -* One small D value: -* - 30 CONTINUE - DO 40 I = 1, N - D( I ) = ONE - 40 CONTINUE - D( N ) = ONE / COND - GO TO 120 -* -* Exponentially distributed D values: -* - 50 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - ALPHA = COND**( -ONE / DBLE( N-1 ) ) - DO 60 I = 2, N - D( I ) = ALPHA**( I-1 ) - 60 CONTINUE - END IF - GO TO 120 -* -* Arithmetically distributed D values: -* - 70 CONTINUE - D( 1 ) = ONE - IF( N.GT.1 ) THEN - TEMP = ONE / COND - ALPHA = ( ONE-TEMP ) / DBLE( N-1 ) - DO 80 I = 2, N - D( I ) = DBLE( N-I )*ALPHA + TEMP - 80 CONTINUE - END IF - GO TO 120 -* -* Randomly distributed D values on ( 1/COND , 1): -* - 90 CONTINUE - ALPHA = LOG( ONE / COND ) - DO 100 I = 1, N - D( I ) = EXP( ALPHA*DLARAN( ISEED ) ) - 100 CONTINUE - GO TO 120 -* -* Randomly distributed D values from IDIST -* - 110 CONTINUE - CALL ZLARNV( IDIST, ISEED, N, D ) -* - 120 CONTINUE -* -* If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign -* random signs to D -* - IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. - $ IRSIGN.EQ.1 ) THEN - DO 130 I = 1, N - CTEMP = ZLARND( 3, ISEED ) - D( I ) = D( I )*( CTEMP / ABS( CTEMP ) ) - 130 CONTINUE - END IF -* -* Reverse if MODE < 0 -* - IF( MODE.LT.0 ) THEN - DO 140 I = 1, N / 2 - CTEMP = D( I ) - D( I ) = D( N+1-I ) - D( N+1-I ) = CTEMP - 140 CONTINUE - END IF -* - END IF -* - RETURN -* -* End of ZLATM1 -* - END diff --git a/testing/lin/zlatms.f b/testing/lin/zlatms.f deleted file mode 100644 index db489821d4c720b263ae4aa8c7c04b11918307e6..0000000000000000000000000000000000000000 --- a/testing/lin/zlatms.f +++ /dev/null @@ -1,1203 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, - $ KL, KU, PACK, A, LDA, WORK, INFO ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIST, PACK, SYM - INTEGER INFO, KL, KU, LDA, M, MODE, N - DOUBLE PRECISION COND, DMAX -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION D( * ) - COMPLEX*16 A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZLATMS generates random matrices with specified singular values -* (or hermitian with specified eigenvalues) -* for testing LAPACK programs. -* -* ZLATMS operates by applying the following sequence of -* operations: -* -* Set the diagonal to D, where D may be input or -* computed according to MODE, COND, DMAX, and SYM -* as described below. -* -* Generate a matrix with the appropriate band structure, by one -* of two methods: -* -* Method A: -* Generate a dense M x N matrix by multiplying D on the left -* and the right by random unitary matrices, then: -* -* Reduce the bandwidth according to KL and KU, using -* Householder transformations. -* -* Method B: -* Convert the bandwidth-0 (i.e., diagonal) matrix to a -* bandwidth-1 matrix using Givens rotations, "chasing" -* out-of-band elements back, much as in QR; then convert -* the bandwidth-1 to a bandwidth-2 matrix, etc. Note -* that for reasonably small bandwidths (relative to M and -* N) this requires less storage, as a dense matrix is not -* generated. Also, for hermitian or symmetric matrices, -* only one triangle is generated. -* -* Method A is chosen if the bandwidth is a large fraction of the -* order of the matrix, and LDA is at least M (so a dense -* matrix can be stored.) Method B is chosen if the bandwidth -* is small (< 1/2 N for hermitian or symmetric, < .3 N+M for -* non-symmetric), or LDA is less than M and not less than the -* bandwidth. -* -* Pack the matrix if desired. Options specified by PACK are: -* no packing -* zero out upper half (if hermitian) -* zero out lower half (if hermitian) -* store the upper half columnwise (if hermitian or upper -* triangular) -* store the lower half columnwise (if hermitian or lower -* triangular) -* store the lower triangle in banded format (if hermitian or -* lower triangular) -* store the upper triangle in banded format (if hermitian or -* upper triangular) -* store the entire matrix in banded format -* If Method B is chosen, and band format is specified, then the -* matrix will be generated in the band format, so no repacking -* will be necessary. -* -* Arguments -* ========= -* -* M - INTEGER -* The number of rows of A. Not modified. -* -* N - INTEGER -* The number of columns of A. N must equal M if the matrix -* is symmetric or hermitian (i.e., if SYM is not 'N') -* Not modified. -* -* DIST - CHARACTER*1 -* On entry, DIST specifies the type of distribution to be used -* to generate the random eigen-/singular values. -* 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) -* 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) -* 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) -* Not modified. -* -* ISEED - INTEGER array, dimension ( 4 ) -* On entry ISEED specifies the seed of the random number -* generator. They should lie between 0 and 4095 inclusive, -* and ISEED(4) should be odd. The random number generator -* uses a linear congruential sequence limited to small -* integers, and so should produce machine independent -* random numbers. The values of ISEED are changed on -* exit, and can be used in the next call to ZLATMS -* to continue the same random number sequence. -* Changed on exit. -* -* SYM - CHARACTER*1 -* If SYM='H', the generated matrix is hermitian, with -* eigenvalues specified by D, COND, MODE, and DMAX; they -* may be positive, negative, or zero. -* If SYM='P', the generated matrix is hermitian, with -* eigenvalues (= singular values) specified by D, COND, -* MODE, and DMAX; they will not be negative. -* If SYM='N', the generated matrix is nonsymmetric, with -* singular values specified by D, COND, MODE, and DMAX; -* they will not be negative. -* If SYM='S', the generated matrix is (complex) symmetric, -* with singular values specified by D, COND, MODE, and -* DMAX; they will not be negative. -* Not modified. -* -* D - DOUBLE PRECISION array, dimension ( MIN( M, N ) ) -* This array is used to specify the singular values or -* eigenvalues of A (see SYM, above.) If MODE=0, then D is -* assumed to contain the singular/eigenvalues, otherwise -* they will be computed according to MODE, COND, and DMAX, -* and placed in D. -* Modified if MODE is nonzero. -* -* MODE - INTEGER -* On entry this describes how the singular/eigenvalues are to -* be specified: -* MODE = 0 means use D as input -* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND -* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND -* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) -* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) -* MODE = 5 sets D to random numbers in the range -* ( 1/COND , 1 ) such that their logarithms -* are uniformly distributed. -* MODE = 6 set D to random numbers from same distribution -* as the rest of the matrix. -* MODE < 0 has the same meaning as ABS(MODE), except that -* the order of the elements of D is reversed. -* Thus if MODE is positive, D has entries ranging from -* 1 to 1/COND, if negative, from 1/COND to 1, -* If SYM='H', and MODE is neither 0, 6, nor -6, then -* the elements of D will also be multiplied by a random -* sign (i.e., +1 or -1.) -* Not modified. -* -* COND - DOUBLE PRECISION -* On entry, this is used as described under MODE above. -* If used, it must be >= 1. Not modified. -* -* DMAX - DOUBLE PRECISION -* If MODE is neither -6, 0 nor 6, the contents of D, as -* computed according to MODE and COND, will be scaled by -* DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or -* singular value (which is to say the norm) will be abs(DMAX). -* Note that DMAX need not be positive: if DMAX is negative -* (or zero), D will be scaled by a negative number (or zero). -* Not modified. -* -* KL - INTEGER -* This specifies the lower bandwidth of the matrix. For -* example, KL=0 implies upper triangular, KL=1 implies upper -* Hessenberg, and KL being at least M-1 means that the matrix -* has full lower bandwidth. KL must equal KU if the matrix -* is symmetric or hermitian. -* Not modified. -* -* KU - INTEGER -* This specifies the upper bandwidth of the matrix. For -* example, KU=0 implies lower triangular, KU=1 implies lower -* Hessenberg, and KU being at least N-1 means that the matrix -* has full upper bandwidth. KL must equal KU if the matrix -* is symmetric or hermitian. -* Not modified. -* -* PACK - CHARACTER*1 -* This specifies packing of matrix as follows: -* 'N' => no packing -* 'U' => zero out all subdiagonal entries (if symmetric -* or hermitian) -* 'L' => zero out all superdiagonal entries (if symmetric -* or hermitian) -* 'C' => store the upper triangle columnwise (only if the -* matrix is symmetric, hermitian, or upper triangular) -* 'R' => store the lower triangle columnwise (only if the -* matrix is symmetric, hermitian, or lower triangular) -* 'B' => store the lower triangle in band storage scheme -* (only if the matrix is symmetric, hermitian, or -* lower triangular) -* 'Q' => store the upper triangle in band storage scheme -* (only if the matrix is symmetric, hermitian, or -* upper triangular) -* 'Z' => store the entire matrix in band storage scheme -* (pivoting can be provided for by using this -* option to store A in the trailing rows of -* the allocated storage) -* -* Using these options, the various LAPACK packed and banded -* storage schemes can be obtained: -* GB - use 'Z' -* PB, SB, HB, or TB - use 'B' or 'Q' -* PP, SP, HB, or TP - use 'C' or 'R' -* -* If two calls to ZLATMS differ only in the PACK parameter, -* they will generate mathematically equivalent matrices. -* Not modified. -* -* A - COMPLEX*16 array, dimension ( LDA, N ) -* On exit A is the desired test matrix. A is first generated -* in full (unpacked) form, and then packed, if so specified -* by PACK. Thus, the first M elements of the first N -* columns will always be modified. If PACK specifies a -* packed or banded storage scheme, all LDA elements of the -* first N columns will be modified; the elements of the -* array which do not correspond to elements of the generated -* matrix are set to zero. -* Modified. -* -* LDA - INTEGER -* LDA specifies the first dimension of A as declared in the -* calling program. If PACK='N', 'U', 'L', 'C', or 'R', then -* LDA must be at least M. If PACK='B' or 'Q', then LDA must -* be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). -* If PACK='Z', LDA must be large enough to hold the packed -* array: MIN( KU, N-1) + MIN( KL, M-1) + 1. -* Not modified. -* -* WORK - COMPLEX*16 array, dimension ( 3*MAX( N, M ) ) -* Workspace. -* Modified. -* -* INFO - INTEGER -* Error code. On exit, INFO will be set to one of the -* following values: -* 0 => normal return -* -1 => M negative or unequal to N and SYM='S', 'H', or 'P' -* -2 => N negative -* -3 => DIST illegal string -* -5 => SYM illegal string -* -7 => MODE not in range -6 to 6 -* -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 -* -10 => KL negative -* -11 => KU negative, or SYM is not 'N' and KU is not equal to -* KL -* -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; -* or PACK='C' or 'Q' and SYM='N' and KL is not zero; -* or PACK='R' or 'B' and SYM='N' and KU is not zero; -* or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not -* N. -* -14 => LDA is less than M, or PACK='Z' and LDA is less than -* MIN(KU,N-1) + MIN(KL,M-1) + 1. -* 1 => Error return from DLATM1 -* 2 => Cannot scale to DMAX (max. sing. value is 0) -* 3 => Error return from ZLAGGE, CLAGHE or CLAGSY -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - COMPLEX*16 CZERO - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) - DOUBLE PRECISION TWOPI - PARAMETER ( TWOPI = 6.2831853071795864769252867663D+0 ) -* .. -* .. Local Scalars .. - LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN, ZSYM - INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA, - $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2, - $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH, - $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC, - $ UUB - DOUBLE PRECISION ALPHA, ANGLE, REALC, TEMP - COMPLEX*16 C, CT, CTEMP, DUMMY, EXTRA, S, ST -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLARND - COMPLEX*16 ZLARND - EXTERNAL LSAME, DLARND, ZLARND -* .. -* .. External Subroutines .. - EXTERNAL DLATM1, DSCAL, XERBLA, ZLAGGE, ZLAGHE, ZLAGSY, - $ ZLAROT, ZLARTG, ZLASET -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, COS, DBLE, DCMPLX, DCONJG, MAX, MIN, MOD, - $ SIN -* .. -* .. Executable Statements .. -* -* 1) Decode and Test the input parameters. -* Initialize flags & seed. -* - INFO = 0 -* -* Quick return if possible -* - IF( M.EQ.0 .OR. N.EQ.0 ) - $ RETURN -* -* Decode DIST -* - IF( LSAME( DIST, 'U' ) ) THEN - IDIST = 1 - ELSE IF( LSAME( DIST, 'S' ) ) THEN - IDIST = 2 - ELSE IF( LSAME( DIST, 'N' ) ) THEN - IDIST = 3 - ELSE - IDIST = -1 - END IF -* -* Decode SYM -* - IF( LSAME( SYM, 'N' ) ) THEN - ISYM = 1 - IRSIGN = 0 - ZSYM = .FALSE. - ELSE IF( LSAME( SYM, 'P' ) ) THEN - ISYM = 2 - IRSIGN = 0 - ZSYM = .FALSE. - ELSE IF( LSAME( SYM, 'S' ) ) THEN - ISYM = 2 - IRSIGN = 0 - ZSYM = .TRUE. - ELSE IF( LSAME( SYM, 'H' ) ) THEN - ISYM = 2 - IRSIGN = 1 - ZSYM = .FALSE. - ELSE - ISYM = -1 - END IF -* -* Decode PACK -* - ISYMPK = 0 - IF( LSAME( PACK, 'N' ) ) THEN - IPACK = 0 - ELSE IF( LSAME( PACK, 'U' ) ) THEN - IPACK = 1 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'L' ) ) THEN - IPACK = 2 - ISYMPK = 1 - ELSE IF( LSAME( PACK, 'C' ) ) THEN - IPACK = 3 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'R' ) ) THEN - IPACK = 4 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'B' ) ) THEN - IPACK = 5 - ISYMPK = 3 - ELSE IF( LSAME( PACK, 'Q' ) ) THEN - IPACK = 6 - ISYMPK = 2 - ELSE IF( LSAME( PACK, 'Z' ) ) THEN - IPACK = 7 - ELSE - IPACK = -1 - END IF -* -* Set certain internal parameters -* - MNMIN = MIN( M, N ) - LLB = MIN( KL, M-1 ) - UUB = MIN( KU, N-1 ) - MR = MIN( M, N+LLB ) - NC = MIN( N, M+UUB ) -* - IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN - MINLDA = UUB + 1 - ELSE IF( IPACK.EQ.7 ) THEN - MINLDA = LLB + UUB + 1 - ELSE - MINLDA = M - END IF -* -* Use Givens rotation method if bandwidth small enough, -* or if LDA is too small to store the matrix unpacked. -* - GIVENS = .FALSE. - IF( ISYM.EQ.1 ) THEN - IF( DBLE( LLB+UUB ).LT.0.3D0*DBLE( MAX( 1, MR+NC ) ) ) - $ GIVENS = .TRUE. - ELSE - IF( 2*LLB.LT.M ) - $ GIVENS = .TRUE. - END IF - IF( LDA.LT.M .AND. LDA.GE.MINLDA ) - $ GIVENS = .TRUE. -* -* Set INFO if an error -* - IF( M.LT.0 ) THEN - INFO = -1 - ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( IDIST.EQ.-1 ) THEN - INFO = -3 - ELSE IF( ISYM.EQ.-1 ) THEN - INFO = -5 - ELSE IF( ABS( MODE ).GT.6 ) THEN - INFO = -7 - ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) - $ THEN - INFO = -8 - ELSE IF( KL.LT.0 ) THEN - INFO = -10 - ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN - INFO = -11 - ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR. - $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR. - $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR. - $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN - INFO = -12 - ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN - INFO = -14 - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLATMS', -INFO ) - RETURN - END IF -* -* Initialize random number generator -* - DO 10 I = 1, 4 - ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) - 10 CONTINUE -* - IF( MOD( ISEED( 4 ), 2 ).NE.1 ) - $ ISEED( 4 ) = ISEED( 4 ) + 1 -* -* 2) Set up D if indicated. -* -* Compute D according to COND and MODE -* - CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) - IF( IINFO.NE.0 ) THEN - INFO = 1 - RETURN - END IF -* -* Choose Top-Down if D is (apparently) increasing, -* Bottom-Up if D is (apparently) decreasing. -* - IF( ABS( D( 1 ) ).LE.ABS( D( MNMIN ) ) ) THEN - TOPDWN = .TRUE. - ELSE - TOPDWN = .FALSE. - END IF -* - IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN -* -* Scale by DMAX -* - TEMP = ABS( D( 1 ) ) - DO 20 I = 2, MNMIN - TEMP = MAX( TEMP, ABS( D( I ) ) ) - 20 CONTINUE -* - IF( TEMP.GT.ZERO ) THEN - ALPHA = DMAX / TEMP - ELSE - INFO = 2 - RETURN - END IF -* - CALL DSCAL( MNMIN, ALPHA, D, 1 ) -* - END IF -* - CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) -* -* 3) Generate Banded Matrix using Givens rotations. -* Also the special case of UUB=LLB=0 -* -* Compute Addressing constants to cover all -* storage formats. Whether GE, HE, SY, GB, HB, or SB, -* upper or lower triangle or both, -* the (i,j)-th element is in -* A( i - ISKEW*j + IOFFST, j ) -* - IF( IPACK.GT.4 ) THEN - ILDA = LDA - 1 - ISKEW = 1 - IF( IPACK.GT.5 ) THEN - IOFFST = UUB + 1 - ELSE - IOFFST = 1 - END IF - ELSE - ILDA = LDA - ISKEW = 0 - IOFFST = 0 - END IF -* -* IPACKG is the format that the matrix is generated in. If this is -* different from IPACK, then the matrix must be repacked at the -* end. It also signals how to compute the norm, for scaling. -* - IPACKG = 0 -* -* Diagonal Matrix -- We are done, unless it -* is to be stored HP/SP/PP/TP (PACK='R' or 'C') -* - IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN - DO 30 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFST, J ) = DCMPLX( D( J ) ) - 30 CONTINUE -* - IF( IPACK.LE.2 .OR. IPACK.GE.5 ) - $ IPACKG = IPACK -* - ELSE IF( GIVENS ) THEN -* -* Check whether to use Givens rotations, -* Householder transformations, or nothing. -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - IF( IPACK.GT.4 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF -* - DO 40 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFST, J ) = DCMPLX( D( J ) ) - 40 CONTINUE -* - IF( TOPDWN ) THEN - JKL = 0 - DO 70 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* Last row actually rotated is M -* Last column actually rotated is MIN( M+JKU, N ) -* - DO 60 JR = 1, MIN( M+JKU, N ) + JKL - 1 - EXTRA = CZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - ICOL = MAX( 1, JR-JKL ) - IF( JR.LT.M ) THEN - IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, - $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IR = JR - IC = ICOL - DO 50 JCH = JR - JKL, 1, -JKL - JKU - IF( IR.LT.M ) THEN - CALL ZLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = DCONJG( REALC*DUMMY ) - S = DCONJG( -S*DUMMY ) - END IF - IROW = MAX( 1, JCH-JKU ) - IL = IR + 2 - IROW - CTEMP = CZERO - ILTEMP = JCH.GT.JKU - CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, - $ A( IROW-ISKEW*IC+IOFFST, IC ), - $ ILDA, CTEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL ZLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), CTEMP, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = DCONJG( REALC*DUMMY ) - S = DCONJG( -S*DUMMY ) -* - ICOL = MAX( 1, JCH-JKU-JKL ) - IL = IC + 2 - ICOL - EXTRA = CZERO - CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., - $ IL, C, S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ CTEMP ) - IC = ICOL - IR = IROW - END IF - 50 CONTINUE - 60 CONTINUE - 70 CONTINUE -* - JKU = UUB - DO 100 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* - DO 90 JC = 1, MIN( N+JKL, M ) + JKU - 1 - EXTRA = CZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - IROW = MAX( 1, JC-JKU ) - IF( JC.LT.N ) THEN - IL = MIN( M, JC+JKL ) + 1 - IROW - CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, - $ S, A( IROW-ISKEW*JC+IOFFST, JC ), - $ ILDA, EXTRA, DUMMY ) - END IF -* -* Chase "EXTRA" back up -* - IC = JC - IR = IROW - DO 80 JCH = JC - JKU, 1, -JKL - JKU - IF( IC.LT.N ) THEN - CALL ZLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, - $ IC+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = DCONJG( REALC*DUMMY ) - S = DCONJG( -S*DUMMY ) - END IF - ICOL = MAX( 1, JCH-JKL ) - IL = IC + 2 - ICOL - CTEMP = CZERO - ILTEMP = JCH.GT.JKL - CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, - $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), - $ ILDA, CTEMP, EXTRA ) - IF( ILTEMP ) THEN - CALL ZLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST, - $ ICOL+1 ), CTEMP, REALC, S, - $ DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = DCONJG( REALC*DUMMY ) - S = DCONJG( -S*DUMMY ) - IROW = MAX( 1, JCH-JKL-JKU ) - IL = IR + 2 - IROW - EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., - $ IL, C, S, A( IROW-ISKEW*ICOL+ - $ IOFFST, ICOL ), ILDA, EXTRA, - $ CTEMP ) - IC = ICOL - IR = IROW - END IF - 80 CONTINUE - 90 CONTINUE - 100 CONTINUE -* - ELSE -* -* Bottom-Up -- Start at the bottom right. -* - JKL = 0 - DO 130 JKU = 1, UUB -* -* Transform from bandwidth JKL, JKU-1 to JKL, JKU -* -* First row actually rotated is M -* First column actually rotated is MIN( M+JKU, N ) -* - IENDCH = MIN( M, N+JKL ) - 1 - DO 120 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1 - EXTRA = CZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - IROW = MAX( 1, JC-JKU+1 ) - IF( JC.GT.0 ) THEN - IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, - $ C, S, A( IROW-ISKEW*JC+IOFFST, - $ JC ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IC = JC - DO 110 JCH = JC + JKL, IENDCH, JKL + JKU - ILEXTR = IC.GT.0 - IF( ILEXTR ) THEN - CALL ZLARTG( A( JCH-ISKEW*IC+IOFFST, IC ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - END IF - IC = MAX( 1, IC ) - ICOL = MIN( N-1, JCH+JKU ) - ILTEMP = JCH + JKU.LT.N - CTEMP = CZERO - CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, - $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), - $ ILDA, EXTRA, CTEMP ) - IF( ILTEMP ) THEN - CALL ZLARTG( A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), CTEMP, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = CZERO - CALL ZLAROT( .FALSE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( JCH-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, CTEMP, EXTRA ) - IC = ICOL - END IF - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE -* - JKU = UUB - DO 160 JKL = 1, LLB -* -* Transform from bandwidth JKL-1, JKU to JKL, JKU -* -* First row actually rotated is MIN( N+JKL, M ) -* First column actually rotated is N -* - IENDCH = MIN( N, M+JKU ) - 1 - DO 150 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1 - EXTRA = CZERO - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - ICOL = MAX( 1, JR-JKL+1 ) - IF( JR.GT.0 ) THEN - IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, - $ C, S, A( JR-ISKEW*ICOL+IOFFST, - $ ICOL ), ILDA, DUMMY, EXTRA ) - END IF -* -* Chase "EXTRA" back down -* - IR = JR - DO 140 JCH = JR + JKU, IENDCH, JKL + JKU - ILEXTR = IR.GT.0 - IF( ILEXTR ) THEN - CALL ZLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - END IF - IR = MAX( 1, IR ) - IROW = MIN( M-1, JCH+JKL ) - ILTEMP = JCH + JKL.LT.M - CTEMP = CZERO - CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, - $ C, S, A( IR-ISKEW*JCH+IOFFST, - $ JCH ), ILDA, EXTRA, CTEMP ) - IF( ILTEMP ) THEN - CALL ZLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ CTEMP, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH - EXTRA = CZERO - CALL ZLAROT( .TRUE., .TRUE., - $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, - $ A( IROW-ISKEW*JCH+IOFFST, JCH ), - $ ILDA, CTEMP, EXTRA ) - IR = IROW - END IF - 140 CONTINUE - 150 CONTINUE - 160 CONTINUE -* - END IF -* - ELSE -* -* Symmetric -- A = U D U' -* Hermitian -- A = U D U* -* - IPACKG = IPACK - IOFFG = IOFFST -* - IF( TOPDWN ) THEN -* -* Top-Down -- Generate Upper triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 6 - IOFFG = UUB + 1 - ELSE - IPACKG = 1 - END IF -* - DO 170 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFG, J ) = DCMPLX( D( J ) ) - 170 CONTINUE -* - DO 200 K = 1, UUB - DO 190 JC = 1, N - 1 - IROW = MAX( 1, JC-K ) - IL = MIN( JC+1, K+2 ) - EXTRA = CZERO - CTEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 ) - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - IF( ZSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = DCONJG( CTEMP ) - CT = DCONJG( C ) - ST = DCONJG( S ) - END IF - CALL ZLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S, - $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA, - $ EXTRA, CTEMP ) - CALL ZLAROT( .TRUE., .TRUE., .FALSE., - $ MIN( K, N-JC )+1, CT, ST, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ CTEMP, DUMMY ) -* -* Chase EXTRA back up the matrix -* - ICOL = JC - DO 180 JCH = JC - K, 1, -K - CALL ZLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, - $ ICOL+1 ), EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = DCONJG( REALC*DUMMY ) - S = DCONJG( -S*DUMMY ) - CTEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - IF( ZSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = DCONJG( CTEMP ) - CT = DCONJG( C ) - ST = DCONJG( S ) - END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), - $ ILDA, CTEMP, EXTRA ) - IROW = MAX( 1, JCH-K ) - IL = MIN( JCH+1, K+2 ) - EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, - $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), - $ ILDA, EXTRA, CTEMP ) - ICOL = JCH - 180 CONTINUE - 190 CONTINUE - 200 CONTINUE -* -* If we need lower triangle, copy from upper. Note that -* the order of copying is chosen to work for 'q' -> 'b' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN - DO 230 JC = 1, N - IROW = IOFFST - ISKEW*JC - IF( ZSYM ) THEN - DO 210 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 210 CONTINUE - ELSE - DO 220 JR = JC, MIN( N, JC+UUB ) - A( JR+IROW, JC ) = DCONJG( A( JC-ISKEW*JR+ - $ IOFFG, JR ) ) - 220 CONTINUE - END IF - 230 CONTINUE - IF( IPACK.EQ.5 ) THEN - DO 250 JC = N - UUB + 1, N - DO 240 JR = N + 2 - JC, UUB + 1 - A( JR, JC ) = CZERO - 240 CONTINUE - 250 CONTINUE - END IF - IF( IPACKG.EQ.6 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - ELSE -* -* Bottom-Up -- Generate Lower triangle only -* - IF( IPACK.GE.5 ) THEN - IPACKG = 5 - IF( IPACK.EQ.6 ) - $ IOFFG = 1 - ELSE - IPACKG = 2 - END IF -* - DO 260 J = 1, MNMIN - A( ( 1-ISKEW )*J+IOFFG, J ) = DCMPLX( D( J ) ) - 260 CONTINUE -* - DO 290 K = 1, UUB - DO 280 JC = N - 1, 1, -1 - IL = MIN( N+1-JC, K+2 ) - EXTRA = CZERO - CTEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC ) - ANGLE = TWOPI*DLARND( 1, ISEED ) - C = COS( ANGLE )*ZLARND( 5, ISEED ) - S = SIN( ANGLE )*ZLARND( 5, ISEED ) - IF( ZSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = DCONJG( CTEMP ) - CT = DCONJG( C ) - ST = DCONJG( S ) - END IF - CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, - $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, - $ CTEMP, EXTRA ) - ICOL = MAX( 1, JC-K+1 ) - CALL ZLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, - $ CT, ST, A( JC-ISKEW*ICOL+IOFFG, - $ ICOL ), ILDA, DUMMY, CTEMP ) -* -* Chase EXTRA back down the matrix -* - ICOL = JC - DO 270 JCH = JC + K, N - 1, K - CALL ZLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ EXTRA, REALC, S, DUMMY ) - DUMMY = ZLARND( 5, ISEED ) - C = REALC*DUMMY - S = S*DUMMY - CTEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - IF( ZSYM ) THEN - CT = C - ST = S - ELSE - CTEMP = DCONJG( CTEMP ) - CT = DCONJG( C ) - ST = DCONJG( S ) - END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, - $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), - $ ILDA, EXTRA, CTEMP ) - IL = MIN( N+1-JCH, K+2 ) - EXTRA = CZERO - CALL ZLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, - $ CT, ST, A( ( 1-ISKEW )*JCH+IOFFG, - $ JCH ), ILDA, CTEMP, EXTRA ) - ICOL = JCH - 270 CONTINUE - 280 CONTINUE - 290 CONTINUE -* -* If we need upper triangle, copy from lower. Note that -* the order of copying is chosen to work for 'b' -> 'q' -* - IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN - DO 320 JC = N, 1, -1 - IROW = IOFFST - ISKEW*JC - IF( ZSYM ) THEN - DO 300 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) - 300 CONTINUE - ELSE - DO 310 JR = JC, MAX( 1, JC-UUB ), -1 - A( JR+IROW, JC ) = DCONJG( A( JC-ISKEW*JR+ - $ IOFFG, JR ) ) - 310 CONTINUE - END IF - 320 CONTINUE - IF( IPACK.EQ.6 ) THEN - DO 340 JC = 1, UUB - DO 330 JR = 1, UUB + 1 - JC - A( JR, JC ) = CZERO - 330 CONTINUE - 340 CONTINUE - END IF - IF( IPACKG.EQ.5 ) THEN - IPACKG = IPACK - ELSE - IPACKG = 0 - END IF - END IF - END IF -* -* Ensure that the diagonal is real if Hermitian -* - IF( .NOT.ZSYM ) THEN - DO 350 JC = 1, N - IROW = IOFFST + ( 1-ISKEW )*JC - A( IROW, JC ) = DCMPLX( DBLE( A( IROW, JC ) ) ) - 350 CONTINUE - END IF -* - END IF -* - ELSE -* -* 4) Generate Banded Matrix by first -* Rotating by random Unitary matrices, -* then reducing the bandwidth using Householder -* transformations. -* -* Note: we should get here only if LDA .ge. N -* - IF( ISYM.EQ.1 ) THEN -* -* Non-symmetric -- A = U D V -* - CALL ZLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK, - $ IINFO ) - ELSE -* -* Symmetric -- A = U D U' or -* Hermitian -- A = U D U* -* - IF( ZSYM ) THEN - CALL ZLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) - ELSE - CALL ZLAGHE( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) - END IF - END IF -* - IF( IINFO.NE.0 ) THEN - INFO = 3 - RETURN - END IF - END IF -* -* 5) Pack the matrix -* - IF( IPACK.NE.IPACKG ) THEN - IF( IPACK.EQ.1 ) THEN -* -* 'U' -- Upper triangular, not packed -* - DO 370 J = 1, M - DO 360 I = J + 1, M - A( I, J ) = CZERO - 360 CONTINUE - 370 CONTINUE -* - ELSE IF( IPACK.EQ.2 ) THEN -* -* 'L' -- Lower triangular, not packed -* - DO 390 J = 2, M - DO 380 I = 1, J - 1 - A( I, J ) = CZERO - 380 CONTINUE - 390 CONTINUE -* - ELSE IF( IPACK.EQ.3 ) THEN -* -* 'C' -- Upper triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 410 J = 1, M - DO 400 I = 1, J - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 400 CONTINUE - 410 CONTINUE -* - ELSE IF( IPACK.EQ.4 ) THEN -* -* 'R' -- Lower triangle packed Columnwise. -* - ICOL = 1 - IROW = 0 - DO 430 J = 1, M - DO 420 I = J, M - IROW = IROW + 1 - IF( IROW.GT.LDA ) THEN - IROW = 1 - ICOL = ICOL + 1 - END IF - A( IROW, ICOL ) = A( I, J ) - 420 CONTINUE - 430 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* 'B' -- The lower triangle is packed as a band matrix. -* 'Q' -- The upper triangle is packed as a band matrix. -* 'Z' -- The whole matrix is packed as a band matrix. -* - IF( IPACK.EQ.5 ) - $ UUB = 0 - IF( IPACK.EQ.6 ) - $ LLB = 0 -* - DO 450 J = 1, UUB - DO 440 I = MIN( J+LLB, M ), 1, -1 - A( I-J+UUB+1, J ) = A( I, J ) - 440 CONTINUE - 450 CONTINUE -* - DO 470 J = UUB + 2, N - DO 460 I = J - UUB, MIN( J+LLB, M ) - A( I-J+UUB+1, J ) = A( I, J ) - 460 CONTINUE - 470 CONTINUE - END IF -* -* If packed, zero out extraneous elements. -* -* Symmetric/Triangular Packed -- -* zero out everything after A(IROW,ICOL) -* - IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN - DO 490 JC = ICOL, M - DO 480 JR = IROW + 1, LDA - A( JR, JC ) = CZERO - 480 CONTINUE - IROW = 0 - 490 CONTINUE -* - ELSE IF( IPACK.GE.5 ) THEN -* -* Packed Band -- -* 1st row is now in A( UUB+2-j, j), zero above it -* m-th row is now in A( M+UUB-j,j), zero below it -* last non-zero diagonal is now in A( UUB+LLB+1,j ), -* zero below it, too. -* - IR1 = UUB + LLB + 2 - IR2 = UUB + M + 2 - DO 520 JC = 1, N - DO 500 JR = 1, UUB + 1 - JC - A( JR, JC ) = CZERO - 500 CONTINUE - DO 510 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA - A( JR, JC ) = CZERO - 510 CONTINUE - 520 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZLATMS -* - END diff --git a/testing/lin/zlatrs.f b/testing/lin/zlatrs.f deleted file mode 100644 index ba7f497efb868ac5c9f1411f3228203de223cf56..0000000000000000000000000000000000000000 --- a/testing/lin/zlatrs.f +++ /dev/null @@ -1,916 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, - $ CNORM, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, NORMIN, TRANS, UPLO - INTEGER INFO, LDA, N - DOUBLE PRECISION SCALE -* .. -* .. Array Arguments .. - DOUBLE PRECISION CNORM( * ) - COMPLEX*16 A( LDA, * ), X( * ) -* .. -* -* Purpose -* ======= -* -* ZLATRS solves one of the triangular systems -* -* A * x = s*b, A^T * x = s*b, or A^H * x = s*b, -* -* with scaling to prevent overflow. Here A is an upper or lower -* triangular matrix, A^T denotes the transpose of A, A^H denotes the -* conjugate transpose of A, x and b are n-element vectors, and s is a -* scaling factor, usually less than or equal to 1, chosen so that the -* components of x will be less than the overflow threshold. If the -* unscaled problem will not cause overflow, the Level 2 BLAS routine -* ZTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j), -* then s is set to 0 and a non-trivial solution to A*x = 0 is returned. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* TRANS (input) CHARACTER*1 -* Specifies the operation applied to A. -* = 'N': Solve A * x = s*b (No transpose) -* = 'T': Solve A^T * x = s*b (Transpose) -* = 'C': Solve A^H * x = s*b (Conjugate transpose) -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* NORMIN (input) CHARACTER*1 -* Specifies whether CNORM has been set or not. -* = 'Y': CNORM contains the column norms on entry -* = 'N': CNORM is not set on entry. On exit, the norms will -* be computed and stored in CNORM. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The triangular matrix A. If UPLO = 'U', the leading n by n -* upper triangular part of the array A contains the upper -* triangular matrix, and the strictly lower triangular part of -* A is not referenced. If UPLO = 'L', the leading n by n lower -* triangular part of the array A contains the lower triangular -* matrix, and the strictly upper triangular part of A is not -* referenced. If DIAG = 'U', the diagonal elements of A are -* also not referenced and are assumed to be 1. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max (1,N). -* -* X (input/output) COMPLEX*16 array, dimension (N) -* On entry, the right hand side b of the triangular system. -* On exit, X is overwritten by the solution vector x. -* -* SCALE (output) DOUBLE PRECISION -* The scaling factor s for the triangular system -* A * x = s*b, A^T * x = s*b, or A^H * x = s*b. -* If SCALE = 0, the matrix A is singular or badly scaled, and -* the vector x is an exact or approximate solution to A*x = 0. -* -* CNORM (input or output) DOUBLE PRECISION array, dimension (N) -* -* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) -* contains the norm of the off-diagonal part of the j-th column -* of A. If TRANS = 'N', CNORM(j) must be greater than or equal -* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) -* must be greater than or equal to the 1-norm. -* -* If NORMIN = 'N', CNORM is an output argument and CNORM(j) -* returns the 1-norm of the offdiagonal part of the j-th column -* of A. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* Further Details -* ======= ======= -* -* A rough bound on x is computed; if that is less than overflow, ZTRSV -* is called, otherwise, specific code is used which checks for possible -* overflow or divide-by-zero at every operation. -* -* A columnwise scheme is used for solving A*x = b. The basic algorithm -* if A is lower triangular is -* -* x[1:n] := b[1:n] -* for j = 1, ..., n -* x(j) := x(j) / A(j,j) -* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] -* end -* -* Define bounds on the components of x after j iterations of the loop: -* M(j) = bound on x[1:j] -* G(j) = bound on x[j+1:n] -* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. -* -* Then for iteration j+1 we have -* M(j+1) <= G(j) / | A(j+1,j+1) | -* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | -* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) -* -* where CNORM(j+1) is greater than or equal to the infinity-norm of -* column j+1 of A, not counting the diagonal. Hence -* -* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) -* 1<=i<=j -* and -* -* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) -* 1<=i< j -* -* Since |x(j)| <= M(j), we use the Level 2 BLAS routine ZTRSV if the -* reciprocal of the largest M(j), j=1,..,n, is larger than -* max(underflow, 1/overflow). -* -* The bound on x(j) is also used to determine when a step in the -* columnwise method can be performed without fear of overflow. If -* the computed bound is greater than a large constant, x is scaled to -* prevent overflow, but if the bound overflows, x is set to 0, x(j) to -* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. -* -* Similarly, a row-wise scheme is used to solve A^T *x = b or -* A^H *x = b. The basic algorithm for A upper triangular is -* -* for j = 1, ..., n -* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) -* end -* -* We simultaneously compute two bounds -* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j -* M(j) = bound on x(i), 1<=i<=j -* -* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we -* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. -* Then the bound on x(j) is -* -* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | -* -* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) -* 1<=i<=j -* -* and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater -* than max(underflow, 1/overflow). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, HALF, ONE, TWO - PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0, - $ TWO = 2.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL NOTRAN, NOUNIT, UPPER - INTEGER I, IMAX, J, JFIRST, JINC, JLAST - DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, - $ XBND, XJ, XMAX - COMPLEX*16 CSUMJ, TJJS, USCAL, ZDUM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX, IZAMAX - DOUBLE PRECISION DLAMCH, DZASUM - COMPLEX*16 ZDOTC, ZDOTU, ZLADIV - EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC, - $ ZDOTU, ZLADIV -* .. -* .. External Subroutines .. - EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1, CABS2 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) - CABS2( ZDUM ) = ABS( DBLE( ZDUM ) / 2.D0 ) + - $ ABS( DIMAG( ZDUM ) / 2.D0 ) -* .. -* .. Executable Statements .. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOTRAN = LSAME( TRANS, 'N' ) - NOUNIT = LSAME( DIAG, 'N' ) -* -* Test the input parameters. -* - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -3 - ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT. - $ LSAME( NORMIN, 'N' ) ) THEN - INFO = -4 - ELSE IF( N.LT.0 ) THEN - INFO = -5 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -7 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLATRS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine machine dependent parameters to control overflow. -* - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / DLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - SCALE = ONE -* - IF( LSAME( NORMIN, 'N' ) ) THEN -* -* Compute the 1-norm of each column, not including the diagonal. -* - IF( UPPER ) THEN -* -* A is upper triangular. -* - DO 10 J = 1, N - CNORM( J ) = DZASUM( J-1, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* A is lower triangular. -* - DO 20 J = 1, N - 1 - CNORM( J ) = DZASUM( N-J, A( J+1, J ), 1 ) - 20 CONTINUE - CNORM( N ) = ZERO - END IF - END IF -* -* Scale the column norms by TSCAL if the maximum element in CNORM is -* greater than BIGNUM/2. -* - IMAX = IDAMAX( N, CNORM, 1 ) - TMAX = CNORM( IMAX ) - IF( TMAX.LE.BIGNUM*HALF ) THEN - TSCAL = ONE - ELSE - TSCAL = HALF / ( SMLNUM*TMAX ) - CALL DSCAL( N, TSCAL, CNORM, 1 ) - END IF -* -* Compute a bound on the computed solution vector to see if the -* Level 2 BLAS routine ZTRSV can be used. -* - XMAX = ZERO - DO 30 J = 1, N - XMAX = MAX( XMAX, CABS2( X( J ) ) ) - 30 CONTINUE - XBND = XMAX -* - IF( NOTRAN ) THEN -* -* Compute the growth in A * x = b. -* - IF( UPPER ) THEN - JFIRST = N - JLAST = 1 - JINC = -1 - ELSE - JFIRST = 1 - JLAST = N - JINC = 1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 60 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, G(0) = max{x(i), i=1,...,n}. -* - GROW = HALF / MAX( XBND, SMLNUM ) - XBND = GROW - DO 40 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 60 -* - TJJS = A( J, J ) - TJJ = CABS1( TJJS ) -* - IF( TJJ.GE.SMLNUM ) THEN -* -* M(j) = G(j-1) / abs(A(j,j)) -* - XBND = MIN( XBND, MIN( ONE, TJJ )*GROW ) - ELSE -* -* M(j) could overflow, set XBND to 0. -* - XBND = ZERO - END IF -* - IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN -* -* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) -* - GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) ) - ELSE -* -* G(j) could overflow, set GROW to 0. -* - GROW = ZERO - END IF - 40 CONTINUE - GROW = XBND - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) ) - DO 50 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 60 -* -* G(j) = G(j-1)*( 1 + CNORM(j) ) -* - GROW = GROW*( ONE / ( ONE+CNORM( J ) ) ) - 50 CONTINUE - END IF - 60 CONTINUE -* - ELSE -* -* Compute the growth in A^T * x = b or A^H * x = b. -* - IF( UPPER ) THEN - JFIRST = 1 - JLAST = N - JINC = 1 - ELSE - JFIRST = N - JLAST = 1 - JINC = -1 - END IF -* - IF( TSCAL.NE.ONE ) THEN - GROW = ZERO - GO TO 90 - END IF -* - IF( NOUNIT ) THEN -* -* A is non-unit triangular. -* -* Compute GROW = 1/G(j) and XBND = 1/M(j). -* Initially, M(0) = max{x(i), i=1,...,n}. -* - GROW = HALF / MAX( XBND, SMLNUM ) - XBND = GROW - DO 70 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 90 -* -* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) -* - XJ = ONE + CNORM( J ) - GROW = MIN( GROW, XBND / XJ ) -* - TJJS = A( J, J ) - TJJ = CABS1( TJJS ) -* - IF( TJJ.GE.SMLNUM ) THEN -* -* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) -* - IF( XJ.GT.TJJ ) - $ XBND = XBND*( TJJ / XJ ) - ELSE -* -* M(j) could overflow, set XBND to 0. -* - XBND = ZERO - END IF - 70 CONTINUE - GROW = MIN( GROW, XBND ) - ELSE -* -* A is unit triangular. -* -* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. -* - GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) ) - DO 80 J = JFIRST, JLAST, JINC -* -* Exit the loop if the growth factor is too small. -* - IF( GROW.LE.SMLNUM ) - $ GO TO 90 -* -* G(j) = ( 1 + CNORM(j) )*G(j-1) -* - XJ = ONE + CNORM( J ) - GROW = GROW / XJ - 80 CONTINUE - END IF - 90 CONTINUE - END IF -* - IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN -* -* Use the Level 2 BLAS solve if the reciprocal of the bound on -* elements of X is not too small. -* - CALL ZTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 ) - ELSE -* -* Use a Level 1 BLAS solve, scaling intermediate results. -* - IF( XMAX.GT.BIGNUM*HALF ) THEN -* -* Scale X so that its components are less than or equal to -* BIGNUM in absolute value. -* - SCALE = ( BIGNUM*HALF ) / XMAX - CALL ZDSCAL( N, SCALE, X, 1 ) - XMAX = BIGNUM - ELSE - XMAX = XMAX*TWO - END IF -* - IF( NOTRAN ) THEN -* -* Solve A * x = b -* - DO 120 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) / A(j,j), scaling x if necessary. -* - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 110 - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by 1/b(j). -* - REC = ONE / XJ - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - XJ = CABS1( X( J ) ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM -* to avoid overflow when dividing by A(j,j). -* - REC = ( TJJ*BIGNUM ) / XJ - IF( CNORM( J ).GT.ONE ) THEN -* -* Scale by 1/CNORM(j) to avoid overflow when -* multiplying x(j) times column j. -* - REC = REC / CNORM( J ) - END IF - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - XJ = CABS1( X( J ) ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0, and compute a solution to A*x = 0. -* - DO 100 I = 1, N - X( I ) = ZERO - 100 CONTINUE - X( J ) = ONE - XJ = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 110 CONTINUE -* -* Scale x if necessary to avoid overflow when adding a -* multiple of column j of A. -* - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -* -* Scale x by 1/(2*abs(x(j))). -* - REC = REC*HALF - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - END IF - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -* -* Scale x by 1/2. -* - CALL ZDSCAL( N, HALF, X, 1 ) - SCALE = SCALE*HALF - END IF -* - IF( UPPER ) THEN - IF( J.GT.1 ) THEN -* -* Compute the update -* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) -* - CALL ZAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X, - $ 1 ) - I = IZAMAX( J-1, X, 1 ) - XMAX = CABS1( X( I ) ) - END IF - ELSE - IF( J.LT.N ) THEN -* -* Compute the update -* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) -* - CALL ZAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1, - $ X( J+1 ), 1 ) - I = J + IZAMAX( N-J, X( J+1 ), 1 ) - XMAX = CABS1( X( I ) ) - END IF - END IF - 120 CONTINUE -* - ELSE IF( LSAME( TRANS, 'T' ) ) THEN -* -* Solve A^T * x = b -* - DO 170 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = CABS1( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = ZLADIV( USCAL, TJJS ) - END IF - IF( REC.LT.ONE ) THEN - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - CSUMJ = ZERO - IF( USCAL.EQ.DCMPLX( ONE ) ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call ZDOTU to perform the dot product. -* - IF( UPPER ) THEN - CSUMJ = ZDOTU( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 130 I = 1, J - 1 - CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I ) - 130 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 140 I = J + 1, N - CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I ) - 140 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN -* -* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - CSUMJ - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = A( J, J )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 160 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0 and compute a solution to A^T *x = 0. -* - DO 150 I = 1, N - X( I ) = ZERO - 150 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 160 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ - END IF - XMAX = MAX( XMAX, CABS1( X( J ) ) ) - 170 CONTINUE -* - ELSE -* -* Solve A^H * x = b -* - DO 220 J = JFIRST, JLAST, JINC -* -* Compute x(j) = b(j) - sum A(k,j)*x(k). -* k<>j -* - XJ = CABS1( X( J ) ) - USCAL = TSCAL - REC = ONE / MAX( XMAX, ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN -* -* If x(j) could overflow, scale x by 1/(2*XMAX). -* - REC = REC*HALF - IF( NOUNIT ) THEN - TJJS = DCONJG( A( J, J ) )*TSCAL - ELSE - TJJS = TSCAL - END IF - TJJ = CABS1( TJJS ) - IF( TJJ.GT.ONE ) THEN -* -* Divide by A(j,j) when scaling x if A(j,j) > 1. -* - REC = MIN( ONE, REC*TJJ ) - USCAL = ZLADIV( USCAL, TJJS ) - END IF - IF( REC.LT.ONE ) THEN - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF -* - CSUMJ = ZERO - IF( USCAL.EQ.DCMPLX( ONE ) ) THEN -* -* If the scaling needed for A in the dot product is 1, -* call ZDOTC to perform the dot product. -* - IF( UPPER ) THEN - CSUMJ = ZDOTC( J-1, A( 1, J ), 1, X, 1 ) - ELSE IF( J.LT.N ) THEN - CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) - END IF - ELSE -* -* Otherwise, use in-line code for the dot product. -* - IF( UPPER ) THEN - DO 180 I = 1, J - 1 - CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )* - $ X( I ) - 180 CONTINUE - ELSE IF( J.LT.N ) THEN - DO 190 I = J + 1, N - CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )* - $ X( I ) - 190 CONTINUE - END IF - END IF -* - IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN -* -* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) -* was not used to scale the dotproduct. -* - X( J ) = X( J ) - CSUMJ - XJ = CABS1( X( J ) ) - IF( NOUNIT ) THEN - TJJS = DCONJG( A( J, J ) )*TSCAL - ELSE - TJJS = TSCAL - IF( TSCAL.EQ.ONE ) - $ GO TO 210 - END IF -* -* Compute x(j) = x(j) / A(j,j), scaling if necessary. -* - TJJ = CABS1( TJJS ) - IF( TJJ.GT.SMLNUM ) THEN -* -* abs(A(j,j)) > SMLNUM: -* - IF( TJJ.LT.ONE ) THEN - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale X by 1/abs(x(j)). -* - REC = ONE / XJ - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - ELSE IF( TJJ.GT.ZERO ) THEN -* -* 0 < abs(A(j,j)) <= SMLNUM: -* - IF( XJ.GT.TJJ*BIGNUM ) THEN -* -* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. -* - REC = ( TJJ*BIGNUM ) / XJ - CALL ZDSCAL( N, REC, X, 1 ) - SCALE = SCALE*REC - XMAX = XMAX*REC - END IF - X( J ) = ZLADIV( X( J ), TJJS ) - ELSE -* -* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and -* scale = 0 and compute a solution to A^H *x = 0. -* - DO 200 I = 1, N - X( I ) = ZERO - 200 CONTINUE - X( J ) = ONE - SCALE = ZERO - XMAX = ZERO - END IF - 210 CONTINUE - ELSE -* -* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot -* product has already been divided by 1/A(j,j). -* - X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ - END IF - XMAX = MAX( XMAX, CABS1( X( J ) ) ) - 220 CONTINUE - END IF - SCALE = SCALE / TSCAL - END IF -* -* Scale the column norms by 1/TSCAL for return. -* - IF( TSCAL.NE.ONE ) THEN - CALL DSCAL( N, ONE / TSCAL, CNORM, 1 ) - END IF -* - RETURN -* -* End of ZLATRS -* - END diff --git a/testing/lin/zlauu2.f b/testing/lin/zlauu2.f deleted file mode 100644 index ac98dfe9b1c28059f595862d43f18af9c11336ec..0000000000000000000000000000000000000000 --- a/testing/lin/zlauu2.f +++ /dev/null @@ -1,181 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLAUU2 computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the unblocked form of the algorithm, calling Level 2 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I - DOUBLE PRECISION AII -* .. -* .. External Functions .. - LOGICAL LSAME - COMPLEX*16 ZDOTC - EXTERNAL LSAME, ZDOTC -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZLACGV -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLAUU2', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA, - $ A( I, I+1 ), LDA ) ) - CALL ZLACGV( N-I, A( I, I+1 ), LDA ) - CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), - $ LDA, A( I, I+1 ), LDA, DCMPLX( AII ), - $ A( 1, I ), 1 ) - CALL ZLACGV( N-I, A( I, I+1 ), LDA ) - ELSE - CALL ZDSCAL( I, AII, A( 1, I ), 1 ) - END IF - 10 CONTINUE -* - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N - AII = A( I, I ) - IF( I.LT.N ) THEN - A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1, - $ A( I+1, I ), 1 ) ) - CALL ZLACGV( I-1, A( I, 1 ), LDA ) - CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, - $ A( I+1, 1 ), LDA, A( I+1, I ), 1, - $ DCMPLX( AII ), A( I, 1 ), LDA ) - CALL ZLACGV( I-1, A( I, 1 ), LDA ) - ELSE - CALL ZDSCAL( I, AII, A( I, 1 ), LDA ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of ZLAUU2 -* - END diff --git a/testing/lin/zlauum.f b/testing/lin/zlauum.f deleted file mode 100644 index 0a3ee3fa00926a23fbdf257aa00440fe9b3ece6b..0000000000000000000000000000000000000000 --- a/testing/lin/zlauum.f +++ /dev/null @@ -1,198 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLAUUM( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZLAUUM computes the product U * U' or L' * L, where the triangular -* factor U or L is stored in the upper or lower triangular part of -* the array A. -* -* If UPLO = 'U' or 'u' then the upper triangle of the result is stored, -* overwriting the factor U in A. -* If UPLO = 'L' or 'l' then the lower triangle of the result is stored, -* overwriting the factor L in A. -* -* This is the blocked form of the algorithm, calling Level 3 BLAS. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the triangular factor stored in the array A -* is upper or lower triangular: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The order of the triangular factor U or L. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the triangular factor U or L. -* On exit, if UPLO = 'U', the upper triangle of A is -* overwritten with the upper triangle of the product U * U'; -* if UPLO = 'L', the lower triangle of A is overwritten with -* the lower triangle of the product L' * L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D+0 ) - COMPLEX*16 CONE - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IB, NB -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZHERK, ZLAUU2, ZTRMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZLAUUM', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'ZLAUUM', UPLO, N, -1, -1, -1 ) -* - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL ZLAUU2( UPLO, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute the product U * U'. -* - DO 10 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose', - $ 'Non-unit', I-1, IB, CONE, A( I, I ), LDA, - $ A( 1, I ), LDA ) - CALL ZLAUU2( 'Upper', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL ZGEMM( 'No transpose', 'Conjugate transpose', - $ I-1, IB, N-I-IB+1, CONE, A( 1, I+IB ), - $ LDA, A( I, I+IB ), LDA, CONE, A( 1, I ), - $ LDA ) - CALL ZHERK( 'Upper', 'No transpose', IB, N-I-IB+1, - $ ONE, A( I, I+IB ), LDA, ONE, A( I, I ), - $ LDA ) - END IF - 10 CONTINUE - ELSE -* -* Compute the product L' * L. -* - DO 20 I = 1, N, NB - IB = MIN( NB, N-I+1 ) - CALL ZTRMM( 'Left', 'Lower', 'Conjugate transpose', - $ 'Non-unit', IB, I-1, CONE, A( I, I ), LDA, - $ A( I, 1 ), LDA ) - CALL ZLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) - IF( I+IB.LE.N ) THEN - CALL ZGEMM( 'Conjugate transpose', 'No transpose', IB, - $ I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA, - $ A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA ) - CALL ZHERK( 'Lower', 'Conjugate transpose', IB, - $ N-I-IB+1, ONE, A( I+IB, I ), LDA, ONE, - $ A( I, I ), LDA ) - END IF - 20 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZLAUUM -* - END diff --git a/testing/lin/zlqt01.f b/testing/lin/zlqt01.f deleted file mode 100644 index 08106718ae8999640d5d97411a24fa2fcefa7402..0000000000000000000000000000000000000000 --- a/testing/lin/zlqt01.f +++ /dev/null @@ -1,196 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLQT01( M, N, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZLQT01 tests ZGELQF, which computes the LQ factorization of an m-by-n -* matrix A, and partially tests ZUNGLQ which forms the n-by-n -* orthogonal matrix Q. -* -* ZLQT01 compares L with A*Q', and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) COMPLEX*16 array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by ZGELQF. -* See ZGELQF for further details. -* -* Q (output) COMPLEX*16 array, dimension (LDA,N) -* The n-by-n orthogonal matrix Q. -* -* L (workspace) COMPLEX*16 array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. -* LDA >= max(M,N). -* -* TAU (output) COMPLEX*16 array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by ZGELQF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (max(M,N)) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY - EXTERNAL DLAMCH, ZLANGE, ZLANSY -* .. -* .. External Subroutines .. - EXTERNAL ZGELQF, ZGEMM, ZHERK, ZLACPY, ZLASET, ZUNGLQ -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX, MIN -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'ZGELQF' - CALL CHAMELEON_ZGELQF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ONE ), Q, LDA ) -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'ZUNGLQ' - CALL CHAMELEON_ZUNGLQ( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L -* - CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ZERO ), L, - $ LDA ) - CALL ZLACPY( 'Lower', M, N, AF, LDA, L, LDA ) -* -* Compute L - A*Q' -* - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, M, N, - $ DCMPLX( -ONE ), A, LDA, Q, LDA, DCMPLX( ONE ), L, - $ LDA ) -* -* Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) . -* - ANORM = ZLANGE( '1', M, N, A, LDA, RWORK ) - RESID = ZLANGE( '1', M, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ONE ), L, LDA ) - CALL ZHERK( 'Upper', 'No transpose', M, N, ONE, Q, LDA, -ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = ZLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of ZLQT01 -* - END diff --git a/testing/lin/zlqt02.f b/testing/lin/zlqt02.f deleted file mode 100644 index d980bea4a0b2bc45b65a4709505e5358f6c22541..0000000000000000000000000000000000000000 --- a/testing/lin/zlqt02.f +++ /dev/null @@ -1,192 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLQT02( M, N, K, A, AF, Q, L, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDA, * ), L( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZLQT02 tests ZUNGLQ, which generates an m-by-n matrix Q with -* orthonornmal rows that is defined as the product of k elementary -* reflectors. -* -* Given the LQ factorization of an m-by-n matrix A, ZLQT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* rows of A; it compares L(1:k,1:m) with A(1:k,1:n)*Q(1:m,1:n)', and -* checks that the rows of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* N >= M >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. M >= K >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by ZLQT01. -* -* AF (input) COMPLEX*16 array, dimension (LDA,N) -* Details of the LQ factorization of A, as returned by ZGELQF. -* See ZGELQF for further details. -* -* Q (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* L (workspace) COMPLEX*16 array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and L. LDA >= N. -* -* TAU (input) COMPLEX*16 array, dimension (M) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS ) -* RESULT(2) = norm( I - Q*Q' ) / ( N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY - EXTERNAL DLAMCH, ZLANGE, ZLANSY -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM, ZHERK, ZLACPY, ZLASET, ZUNGLQ -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ONE ), Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'ZUNGLQ' - CALL CHAMELEON_ZUNGLQ( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy L(1:k,1:m) -* - CALL ZLASET( 'Full', K, M, DCMPLX( ZERO ), DCMPLX( ZERO ), L, - $ LDA ) - CALL ZLACPY( 'Lower', K, M, AF, LDA, L, LDA ) -* -* Compute L(1:k,1:m) - A(1:k,1:n) * Q(1:m,1:n)' -* - CALL ZGEMM( 'No transpose', 'Conjugate transpose', K, M, N, - $ DCMPLX( -ONE ), A, LDA, Q, LDA, DCMPLX( ONE ), L, - $ LDA ) -* -* Compute norm( L - A*Q' ) / ( N * norm(A) * EPS ) . -* - ANORM = ZLANGE( '1', K, N, A, LDA, RWORK ) - RESID = ZLANGE( '1', K, M, L, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, N ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q*Q' -* - CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ONE ), L, LDA ) - CALL ZHERK( 'Upper', 'No transpose', M, N, -ONE, Q, LDA, ONE, L, - $ LDA ) -* -* Compute norm( I - Q*Q' ) / ( N * EPS ) . -* - RESID = ZLANSY( '1', 'Upper', M, L, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of ZLQT02 -* - END diff --git a/testing/lin/zlqt03.f b/testing/lin/zlqt03.f deleted file mode 100644 index 7c7f54ac24c3bb0d63210b5371cd1fed384f551c..0000000000000000000000000000000000000000 --- a/testing/lin/zlqt03.f +++ /dev/null @@ -1,239 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZLQT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZLQT03 tests ZUNMLQ, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* ZLQT03 compares the results of a call to ZUNMLQ with the results of -* forming Q explicitly by a call to ZUNGLQ and then performing matrix -* multiplication by a call to ZGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows or columns of the matrix C; C is n-by-m if -* Q is applied from the left, or m-by-n if Q is applied from -* the right. M >= 0. -* -* N (input) INTEGER -* The order of the orthogonal matrix Q. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. N >= K >= 0. -* -* AF (input) COMPLEX*16 array, dimension (LDA,N) -* Details of the LQ factorization of an m-by-n matrix, as -* returned by ZGELQF. See CGELQF for further details. -* -* C (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* CC (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* Q (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) COMPLEX*16 array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the LQ factorization in AF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an n-by-n orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( N * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( N * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( N * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( N * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - DOUBLE PRECISION CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLAMCH, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM, ZLACPY, ZLARNV, ZLASET, ZUNGLQ, ZUNMLQ -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k rows of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL ZLASET( 'Full', N, N, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), DCMPLX( ONE ), - $ Q, LDA ) - ENDIF -* -* Generate the n-by-n matrix Q -* - SRNAMT = 'ZUNGLQ' - CALL CHAMELEON_ZUNGLQ( N, N, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = N - NC = M - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = M - NC = N - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL ZLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = ZLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.ZERO ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - CHAMELEON_TRANS = CHAMELEONNOTRANS - TRANS = 'N' - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - END IF -* -* Copy C -* - CALL ZLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'ZUNMLQ' - CALL CHAMELEON_ZUNMLQ( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), - $ DCMPLX( ONE ), Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL ZGEMM( TRANS, 'No transpose', MC, NC, MC, - $ DCMPLX( -ONE ), Q, LDA, C, LDA, - $ DCMPLX( ONE ), CC, LDA ) - ELSE - CALL ZGEMM( 'No transpose', TRANS, MC, NC, NC, - $ DCMPLX( -ONE ), C, LDA, Q, LDA, - $ DCMPLX( ONE ), CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = ZLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( DBLE( MAX( 1, N ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of ZLQT03 -* - END diff --git a/testing/lin/zpocon.f b/testing/lin/zpocon.f deleted file mode 100644 index b3e91f0572b5a25abc1e7cc934304b8bb3ba628c..0000000000000000000000000000000000000000 --- a/testing/lin/zpocon.f +++ /dev/null @@ -1,221 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, - $ INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call ZLACN2 in place of ZLACON, 10 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N - DOUBLE PRECISION ANORM, RCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZPOCON estimates the reciprocal of the condition number (in the -* 1-norm) of a complex Hermitian positive definite matrix using the -* Cholesky factorization A = U^H*U or A = L*L^H computed by ZPOTRF. -* -* An estimate is obtained for norm(inv(A)), and the reciprocal of the -* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^H*U or A = L*L^H, as computed by ZPOTRF. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* ANORM (input) DOUBLE PRECISION -* The 1-norm (or infinity-norm) of the Hermitian matrix A. -* -* RCOND (output) DOUBLE PRECISION -* The reciprocal of the condition number of the matrix A, -* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an -* estimate of the 1-norm of inv(A) computed in this routine. -* -* WORK (workspace) COMPLEX*16 array, dimension (2*N) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - CHARACTER NORMIN - INTEGER IX, KASE - DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM - COMPLEX*16 ZDUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IZAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, IZAMAX, DLAMCH -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLATRS -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - ELSE IF( ANORM.LT.ZERO ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZPOCON', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - RCOND = ZERO - IF( N.EQ.0 ) THEN - RCOND = ONE - RETURN - ELSE IF( ANORM.EQ.ZERO ) THEN - RETURN - END IF -* - SMLNUM = DLAMCH( 'Safe minimum' ) -* -* Estimate the 1-norm of inv(A). -* - KASE = 0 - NORMIN = 'N' - 10 CONTINUE - CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( UPPER ) THEN -* -* Multiply by inv(U'). -* - CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', - $ NORMIN, N, A, LDA, WORK, SCALEL, RWORK, INFO ) - NORMIN = 'Y' -* -* Multiply by inv(U). -* - CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEU, RWORK, INFO ) - ELSE -* -* Multiply by inv(L). -* - CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, - $ A, LDA, WORK, SCALEL, RWORK, INFO ) - NORMIN = 'Y' -* -* Multiply by inv(L'). -* - CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Non-unit', - $ NORMIN, N, A, LDA, WORK, SCALEU, RWORK, INFO ) - END IF -* -* Multiply by 1/SCALE if doing so will not cause overflow. -* - SCALE = SCALEL*SCALEU - IF( SCALE.NE.ONE ) THEN - IX = IZAMAX( N, WORK, 1 ) - IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO ) - $ GO TO 20 - CALL ZDRSCL( N, SCALE, WORK, 1 ) - END IF - GO TO 10 - END IF -* -* Compute the estimate of the reciprocal condition number. -* - IF( AINVNM.NE.ZERO ) - $ RCOND = ( ONE / AINVNM ) / ANORM -* - 20 CONTINUE - RETURN -* -* End of ZPOCON -* - END diff --git a/testing/lin/zpoequ.f b/testing/lin/zpoequ.f deleted file mode 100644 index ef5858a8719818815dfbbcf609c5302c2d09fce9..0000000000000000000000000000000000000000 --- a/testing/lin/zpoequ.f +++ /dev/null @@ -1,174 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOEQU( N, A, LDA, S, SCOND, AMAX, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER INFO, LDA, N - DOUBLE PRECISION AMAX, SCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION S( * ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZPOEQU computes row and column scalings intended to equilibrate a -* Hermitian positive definite matrix A and reduce its condition number -* (with respect to the two-norm). S contains the scale factors, -* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with -* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This -* choice of S puts the condition number of B within a factor N of the -* smallest possible condition number over all possible diagonal -* scalings. -* -* Arguments -* ========= -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The N-by-N Hermitian positive definite matrix whose scaling -* factors are to be computed. Only the diagonal elements of A -* are referenced. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* S (output) DOUBLE PRECISION array, dimension (N) -* If INFO = 0, S contains the scale factors for A. -* -* SCOND (output) DOUBLE PRECISION -* If INFO = 0, S contains the ratio of the smallest S(i) to -* the largest S(i). If SCOND >= 0.1 and AMAX is neither too -* large nor too small, it is not worth scaling by S. -* -* AMAX (output) DOUBLE PRECISION -* Absolute value of largest matrix element. If AMAX is very -* close to overflow or very close to underflow, the matrix -* should be scaled. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the i-th diagonal element is nonpositive. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I - DOUBLE PRECISION SMIN -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, MIN, SQRT -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( N.LT.0 ) THEN - INFO = -1 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -3 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZPOEQU', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) THEN - SCOND = ONE - AMAX = ZERO - RETURN - END IF -* -* Find the minimum and maximum diagonal elements. -* - S( 1 ) = DBLE( A( 1, 1 ) ) - SMIN = S( 1 ) - AMAX = S( 1 ) - DO 10 I = 2, N - S( I ) = DBLE( A( I, I ) ) - SMIN = MIN( SMIN, S( I ) ) - AMAX = MAX( AMAX, S( I ) ) - 10 CONTINUE -* - IF( SMIN.LE.ZERO ) THEN -* -* Find the first non-positive diagonal element and return. -* - DO 20 I = 1, N - IF( S( I ).LE.ZERO ) THEN - INFO = I - RETURN - END IF - 20 CONTINUE - ELSE -* -* Set the scale factors to the reciprocals -* of the diagonal elements. -* - DO 30 I = 1, N - S( I ) = ONE / SQRT( S( I ) ) - 30 CONTINUE -* -* Compute SCOND = min(S(I)) / max(S(I)) -* - SCOND = SQRT( SMIN ) / SQRT( AMAX ) - END IF - RETURN -* -* End of ZPOEQU -* - END diff --git a/testing/lin/zporfs.f b/testing/lin/zporfs.f deleted file mode 100644 index 696739a6cc6bdb5cf6e65a6cc81a72df19dfdcf9..0000000000000000000000000000000000000000 --- a/testing/lin/zporfs.f +++ /dev/null @@ -1,385 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, - $ LDX, FERR, BERR, WORK, RWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* Modified to call ZLACN2 in place of ZLACON, 10 Feb 03, SJH. -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* .. -* .. Array Arguments .. - DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZPORFS improves the computed solution to a system of linear -* equations when the coefficient matrix is Hermitian positive definite, -* and provides error bounds and backward error estimates for the -* solution. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input) COMPLEX*16 array, dimension (LDAF,N) -* The triangular factor U or L from the Cholesky factorization -* A = U^H*U or A = L*L^H, as computed by ZPOTRF. -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* B (input) COMPLEX*16 array, dimension (LDB,NRHS) -* The right hand side matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input/output) COMPLEX*16 array, dimension (LDX,NRHS) -* On entry, the solution matrix X, as computed by ZPOTRS. -* On exit, the improved solution matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* FERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) COMPLEX*16 array, dimension (2*N) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* Internal Parameters -* =================== -* -* ITMAX is the maximum number of steps of iterative refinement. -* -* ==================================================================== -* -* .. Parameters .. - INTEGER ITMAX - PARAMETER ( ITMAX = 5 ) - DOUBLE PRECISION ZERO - PARAMETER ( ZERO = 0.0D+0 ) - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) - DOUBLE PRECISION TWO - PARAMETER ( TWO = 2.0D+0 ) - DOUBLE PRECISION THREE - PARAMETER ( THREE = 3.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER COUNT, I, J, K, KASE, NZ, CHAMELEON_UPLO - DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK - COMPLEX*16 ZDUM -* .. -* .. Local Arrays .. - INTEGER ISAVE( 3 ) -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHEMV, ZLACN2, ZPOTRS -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, DLAMCH -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -7 - ELSE IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -9 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZPORFS', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN - DO 10 J = 1, NRHS - FERR( J ) = ZERO - BERR( J ) = ZERO - 10 CONTINUE - RETURN - END IF -* - IF ( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* -* NZ = maximum number of nonzero elements in each row of A, plus 1 -* - NZ = N + 1 - EPS = DLAMCH( 'Epsilon' ) - SAFMIN = DLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN - SAFE2 = SAFE1 / EPS -* -* Do for each right hand side -* - DO 140 J = 1, NRHS -* - COUNT = 1 - LSTRES = THREE - 20 CONTINUE -* -* Loop until stopping criterion is satisfied. -* -* Compute residual R = B - A * X -* - CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) -* -* Compute componentwise relative backward error from formula -* -* max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) ) -* -* where abs(Z) is the componentwise absolute value of the matrix -* or vector Z. If the i-th component of the denominator is less -* than SAFE2, then SAFE1 is added to the i-th components of the -* numerator and denominator before dividing. -* - DO 30 I = 1, N - RWORK( I ) = CABS1( B( I, J ) ) - 30 CONTINUE -* -* Compute abs(A)*abs(X) + abs(B). -* - IF( UPPER ) THEN - DO 50 K = 1, N - S = ZERO - XK = CABS1( X( K, J ) ) - DO 40 I = 1, K - 1 - RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK - S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) ) - 40 CONTINUE - RWORK( K ) = RWORK( K ) + ABS( DBLE( A( K, K ) ) )*XK + S - 50 CONTINUE - ELSE - DO 70 K = 1, N - S = ZERO - XK = CABS1( X( K, J ) ) - RWORK( K ) = RWORK( K ) + ABS( DBLE( A( K, K ) ) )*XK - DO 60 I = K + 1, N - RWORK( I ) = RWORK( I ) + CABS1( A( I, K ) )*XK - S = S + CABS1( A( I, K ) )*CABS1( X( I, J ) ) - 60 CONTINUE - RWORK( K ) = RWORK( K ) + S - 70 CONTINUE - END IF - S = ZERO - DO 80 I = 1, N - IF( RWORK( I ).GT.SAFE2 ) THEN - S = MAX( S, CABS1( WORK( I ) ) / RWORK( I ) ) - ELSE - S = MAX( S, ( CABS1( WORK( I ) )+SAFE1 ) / - $ ( RWORK( I )+SAFE1 ) ) - END IF - 80 CONTINUE - BERR( J ) = S -* -* Test stopping criterion. Continue iterating if -* 1) The residual BERR(J) is larger than machine epsilon, and -* 2) BERR(J) decreased by at least a factor of 2 during the -* last iteration, and -* 3) At most ITMAX iterations tried. -* - IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND. - $ COUNT.LE.ITMAX ) THEN -* -* Update solution and try again. -* - CALL CHAMELEON_ZPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK, N, INFO ) - CALL ZAXPY( N, ONE, WORK, 1, X( 1, J ), 1 ) - LSTRES = BERR( J ) - COUNT = COUNT + 1 - GO TO 20 - END IF -* -* Bound error from formula -* -* norm(X - XTRUE) / norm(X) .le. FERR = -* norm( abs(inv(A))* -* ( abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) / norm(X) -* -* where -* norm(Z) is the magnitude of the largest component of Z -* inv(A) is the inverse of A -* abs(Z) is the componentwise absolute value of the matrix or -* vector Z -* NZ is the maximum number of nonzeros in any row of A, plus 1 -* EPS is machine epsilon -* -* The i-th component of abs(R)+NZ*EPS*(abs(A)*abs(X)+abs(B)) -* is incremented by SAFE1 if the i-th component of -* abs(A)*abs(X) + abs(B) is less than SAFE2. -* -* Use ZLACN2 to estimate the infinity-norm of the matrix -* inv(A) * diag(W), -* where W = abs(R) + NZ*EPS*( abs(A)*abs(X)+abs(B) ))) -* - DO 90 I = 1, N - IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) - ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 - END IF - 90 CONTINUE -* - KASE = 0 - 100 CONTINUE - CALL ZLACN2( N, WORK( N+1 ), WORK, FERR( J ), KASE, ISAVE ) - IF( KASE.NE.0 ) THEN - IF( KASE.EQ.1 ) THEN -* -* Multiply by diag(W)*inv(A'). -* - CALL CHAMELEON_ZPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK, N, INFO ) - DO 110 I = 1, N - WORK( I ) = RWORK( I )*WORK( I ) - 110 CONTINUE - ELSE IF( KASE.EQ.2 ) THEN -* -* Multiply by inv(A)*diag(W). -* - DO 120 I = 1, N - WORK( I ) = RWORK( I )*WORK( I ) - 120 CONTINUE - CALL CHAMELEON_ZPOTRS( CHAMELEON_UPLO, N, 1, AF, LDAF, - $ WORK, N, INFO ) - END IF - GO TO 100 - END IF -* -* Normalize error. -* - LSTRES = ZERO - DO 130 I = 1, N - LSTRES = MAX( LSTRES, CABS1( X( I, J ) ) ) - 130 CONTINUE - IF( LSTRES.NE.ZERO ) - $ FERR( J ) = FERR( J ) / LSTRES -* - 140 CONTINUE -* - RETURN -* -* End of ZPORFS -* - END diff --git a/testing/lin/zposvx.f b/testing/lin/zposvx.f deleted file mode 100644 index 4d8d322fedb94677e92f2901be7e415cf56fb2e2..0000000000000000000000000000000000000000 --- a/testing/lin/zposvx.f +++ /dev/null @@ -1,422 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, - $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, - $ RWORK, INFO ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK driver routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, UPLO - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * ), S( * ) - COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZPOSVX uses the Cholesky factorization A = U^H*U or A = L*L^H to -* compute the solution to a complex system of linear equations -* A * X = B, -* where A is an N-by-N Hermitian positive definite matrix and X and B -* are N-by-NRHS matrices. -* -* Error bounds on the solution and a condition estimate are also -* provided. -* -* Description -* =========== -* -* The following steps are performed: -* -* 1. If FACT = 'E', real scaling factors are computed to equilibrate -* the system: -* diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B -* Whether or not the system will be equilibrated depends on the -* scaling of the matrix A, but if equilibration is used, A is -* overwritten by diag(S)*A*diag(S) and B by diag(S)*B. -* -* 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to -* factor the matrix A (after equilibration if FACT = 'E') as -* A = U^H* U, if UPLO = 'U', or -* A = L * L^H, if UPLO = 'L', -* where U is an upper triangular matrix and L is a lower triangular -* matrix. -* -* 3. If the leading i-by-i principal minor is not positive definite, -* then the routine returns with INFO = i. Otherwise, the factored -* form of A is used to estimate the condition number of the matrix -* A. If the reciprocal of the condition number is less than machine -* precision, INFO = N+1 is returned as a warning, but the routine -* still goes on to solve for X and compute error bounds as -* described below. -* -* 4. The system of equations is solved for X using the factored form -* of A. -* -* 5. Iterative refinement is applied to improve the computed solution -* matrix and calculate error bounds and backward error estimates -* for it. -* -* 6. If equilibration was used, the matrix X is premultiplied by -* diag(S) so that it solves the original system before -* equilibration. -* -* Arguments -* ========= -* -* FACT (input) CHARACTER*1 -* Specifies whether or not the factored form of the matrix A is -* supplied on entry, and if not, whether the matrix A should be -* equilibrated before it is factored. -* = 'F': On entry, AF contains the factored form of A. -* If EQUED = 'Y', the matrix A has been equilibrated -* with scaling factors given by S. A and AF will not -* be modified. -* = 'N': The matrix A will be copied to AF and factored. -* = 'E': The matrix A will be equilibrated if necessary, then -* copied to AF and factored. -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The number of linear equations, i.e., the order of the -* matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of the matrices B and X. NRHS >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the Hermitian matrix A, except if FACT = 'F' and -* EQUED = 'Y', then A must contain the equilibrated matrix -* diag(S)*A*diag(S). 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. A is not modified if -* FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit. -* -* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by -* diag(S)*A*diag(S). -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* AF (input or output) COMPLEX*16 array, dimension (LDAF,N) -* If FACT = 'F', then AF is an input argument and on entry -* contains the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H, in the same storage -* format as A. If EQUED .ne. 'N', then AF is the factored form -* of the equilibrated matrix diag(S)*A*diag(S). -* -* If FACT = 'N', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H of the original -* matrix A. -* -* If FACT = 'E', then AF is an output argument and on exit -* returns the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H of the equilibrated -* matrix A (see the description of A for the form of the -* equilibrated matrix). -* -* LDAF (input) INTEGER -* The leading dimension of the array AF. LDAF >= max(1,N). -* -* EQUED (input or output) CHARACTER*1 -* Specifies the form of equilibration that was done. -* = 'N': No equilibration (always true if FACT = 'N'). -* = 'Y': Equilibration was done, i.e., A has been replaced by -* diag(S) * A * diag(S). -* EQUED is an input argument if FACT = 'F'; otherwise, it is an -* output argument. -* -* S (input or output) DOUBLE PRECISION array, dimension (N) -* The scale factors for A; not accessed if EQUED = 'N'. S is -* an input argument if FACT = 'F'; otherwise, S is an output -* argument. If FACT = 'F' and EQUED = 'Y', each element of S -* must be positive. -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the N-by-NRHS righthand side matrix B. -* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y', -* B is overwritten by diag(S) * B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (output) COMPLEX*16 array, dimension (LDX,NRHS) -* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to -* the original system of equations. Note that if EQUED = 'Y', -* A and B are modified on exit, and the solution to the -* equilibrated system is inv(diag(S))*X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* RCOND (output) DOUBLE PRECISION -* The estimate of the reciprocal condition number of the matrix -* A after equilibration (if done). If RCOND is less than the -* machine precision (in particular, if RCOND = 0), the matrix -* is singular to working precision. This condition is -* indicated by a return code of INFO > 0. -* -* FERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bound for each solution vector -* X(j) (the j-th column of the solution matrix X). -* If XTRUE is the true solution corresponding to X(j), FERR(j) -* is an estimated upper bound for the magnitude of the largest -* element in (X(j) - XTRUE) divided by the magnitude of the -* largest element in X(j). The estimate is as reliable as -* the estimate for RCOND, and is almost always a slight -* overestimate of the true error. -* -* BERR (output) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector X(j) (i.e., the smallest relative change in -* any element of A or B that makes X(j) an exact solution). -* -* WORK (workspace) COMPLEX*16 array, dimension (2*N) -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, and i is -* <= N: the leading minor of order i of A is -* not positive definite, so the factorization -* could not be completed, and the solution has not -* been computed. RCOND = 0 is returned. -* = N+1: U is nonsingular, but RCOND is less than machine -* precision, meaning that the matrix is singular -* to working precision. Nevertheless, the -* solution and error bounds are computed because -* there are a number of situations where the -* computed solution can be more accurate than the -* value of RCOND would suggest. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL EQUIL, NOFACT, RCEQU - INTEGER I, INFEQU, J - DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM - INTEGER CHAMELEON_UPLO -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANHE - EXTERNAL LSAME, DLAMCH, ZLANHE -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZLACPY, ZLAQHE, ZPOCON, ZPOEQU, ZPORFS, - $ ZPOTRF, ZPOTRS -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - RCEQU = .FALSE. - ELSE - RCEQU = LSAME( EQUED, 'Y' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) - $ THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -9 - ELSE - IF( RCEQU ) THEN - SMIN = BIGNUM - SMAX = ZERO - DO 10 J = 1, N - SMIN = MIN( SMIN, S( J ) ) - SMAX = MAX( SMAX, S( J ) ) - 10 CONTINUE - IF( SMIN.LE.ZERO ) THEN - INFO = -10 - ELSE IF( N.GT.0 ) THEN - SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM ) - ELSE - SCOND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -12 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -14 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZPOSVX', -INFO ) - RETURN - END IF -* - IF( LSAME( UPLO, 'U' ) ) THEN - CHAMELEON_UPLO = CHAMELEONUPPER - ELSE - CHAMELEON_UPLO = CHAMELEONLOWER - ENDIF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL ZPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) - RCEQU = LSAME( EQUED, 'Y' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( RCEQU ) THEN - DO 30 J = 1, NRHS - DO 20 I = 1, N - B( I, J ) = S( I )*B( I, J ) - 20 CONTINUE - 30 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the Cholesky factorization A = U'*U or A = L*L'. -* - CALL ZLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CHAMELEON_ZPOTRF( CHAMELEON_UPLO, N, AF, LDAF, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 )THEN - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A. -* - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) -* -* Compute the reciprocal of the condition number of A. -* - CALL ZPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CHAMELEON_ZPOTRS( CHAMELEON_UPLO, N, NRHS, AF, LDAF, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL ZPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, - $ FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( RCEQU ) THEN - DO 50 J = 1, NRHS - DO 40 I = 1, N - X( I, J ) = S( I )*X( I, J ) - 40 CONTINUE - 50 CONTINUE - DO 60 J = 1, NRHS - FERR( J ) = FERR( J ) / SCOND - 60 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RETURN -* -* End of ZPOSVX -* - END diff --git a/testing/lin/zpot01.f b/testing/lin/zpot01.f deleted file mode 100644 index 9b51cb4296653ee62660473c884e6c8925d17138..0000000000000000000000000000000000000000 --- a/testing/lin/zpot01.f +++ /dev/null @@ -1,213 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAFAC, N - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), AFAC( LDAFAC, * ) -* .. -* -* Purpose -* ======= -* -* ZPOT01 reconstructs a Hermitian positive definite matrix A from -* its L*L' or U'*U factorization and computes the residual -* norm( L*L' - A ) / ( N * norm(A) * EPS ) or -* norm( U'*U - A ) / ( N * norm(A) * EPS ), -* where EPS is the machine epsilon, L' is the conjugate transpose of L, -* and U' is the conjugate transpose of U. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AFAC (input/output) COMPLEX*16 array, dimension (LDAFAC,N) -* On entry, the factor L or U from the L*L' or U'*U -* factorization of A. -* Overwritten with the reconstructed matrix, and then with the -* difference L*L' - A (or U'*U - A). -* -* LDAFAC (input) INTEGER -* The leading dimension of the array AFAC. LDAFAC >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RESID (output) DOUBLE PRECISION -* If UPLO = 'L', norm(L*L' - A) / ( N * norm(A) * EPS ) -* If UPLO = 'U', norm(U'*U - A) / ( N * norm(A) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - INTEGER I, J, K - DOUBLE PRECISION ANORM, EPS, TR - COMPLEX*16 TC -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANHE - COMPLEX*16 ZDOTC - EXTERNAL LSAME, DLAMCH, ZLANHE, ZDOTC -* .. -* .. External Subroutines .. - EXTERNAL ZHER, ZSCAL, ZTRMV -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DIMAG -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Check the imaginary parts of the diagonal elements and return with -* an error code if any are nonzero. -* - DO 10 J = 1, N - IF( DIMAG( AFAC( J, J ) ).NE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF - 10 CONTINUE -* -* Compute the product U'*U, overwriting U. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 K = N, 1, -1 -* -* Compute the (K,K) element of the result. -* - TR = ZDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) - AFAC( K, K ) = TR -* -* Compute the rest of column K. -* - CALL ZTRMV( 'Upper', 'Conjugate', 'Non-unit', K-1, AFAC, - $ LDAFAC, AFAC( 1, K ), 1 ) -* - 20 CONTINUE -* -* Compute the product L*L', overwriting L. -* - ELSE - DO 30 K = N, 1, -1 -* -* Add a multiple of column K of the factor L to each of -* columns K+1 through N. -* - IF( K+1.LE.N ) - $ CALL ZHER( 'Lower', N-K, ONE, AFAC( K+1, K ), 1, - $ AFAC( K+1, K+1 ), LDAFAC ) -* -* Scale column K by the diagonal element. -* - TC = AFAC( K, K ) - CALL ZSCAL( N-K+1, TC, AFAC( K, K ), 1 ) -* - 30 CONTINUE - END IF -* -* Compute the difference L*L' - A (or U'*U - A). -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 50 J = 1, N - DO 40 I = 1, J - 1 - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 40 CONTINUE - AFAC( J, J ) = AFAC( J, J ) - DBLE( A( J, J ) ) - 50 CONTINUE - ELSE - DO 70 J = 1, N - AFAC( J, J ) = AFAC( J, J ) - DBLE( A( J, J ) ) - DO 60 I = J + 1, N - AFAC( I, J ) = AFAC( I, J ) - A( I, J ) - 60 CONTINUE - 70 CONTINUE - END IF -* -* Compute norm( L*U - A ) / ( N * norm(A) * EPS ) -* - RESID = ZLANHE( '1', UPLO, N, AFAC, LDAFAC, RWORK ) -* - RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS -* - RETURN -* -* End of ZPOT01 -* - END diff --git a/testing/lin/zpot02.f b/testing/lin/zpot02.f deleted file mode 100644 index 2b65f386041547b6482a6cf17c60fc4ea01d435b..0000000000000000000000000000000000000000 --- a/testing/lin/zpot02.f +++ /dev/null @@ -1,173 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, - $ RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZPOT02 computes the residual for the solution of a Hermitian system -* of linear equations A*x = b: -* -* RESID = norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) + norm(RHS))* N * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 CONE - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J - DOUBLE PRECISION ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DZASUM, ZLANHE, CLANGE - EXTERNAL DLAMCH, DZASUM, ZLANHE, CLANGE -* .. -* .. External Subroutines .. - EXTERNAL ZHEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) - RHSNORM = CLANGE( '1', N, NRHS, B, LDB, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X -* - CALL ZHEMM( 'Left', UPLO, N, NRHS, -CONE, A, LDA, X, LDX, CONE, B, - $ LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DZASUM( N, B( 1, J ), 1 ) - XNORM = DZASUM( N, X( 1, J ), 1 ) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM) / ((ANORM * XNORM + RHSNORM)* - $ N *EPS )) - END IF - 10 CONTINUE -* - RETURN -* -* End of ZPOT02 -* - END diff --git a/testing/lin/zpot03.f b/testing/lin/zpot03.f deleted file mode 100644 index 0eead1c1ff4e10da1dd94ded71fa6de26f682898..0000000000000000000000000000000000000000 --- a/testing/lin/zpot03.f +++ /dev/null @@ -1,188 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOT03( UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, - $ RWORK, RCOND, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDAINV, LDWORK, N - DOUBLE PRECISION RCOND, RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), AINV( LDAINV, * ), - $ WORK( LDWORK, * ) -* .. -* -* Purpose -* ======= -* -* ZPOT03 computes the residual for a Hermitian matrix times its -* inverse: -* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original Hermitian matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N) -* -* AINV (input/output) COMPLEX*16 array, dimension (LDAINV,N) -* On entry, the inverse of the matrix A, stored as a Hermitian -* matrix in the same format as A. -* In this version, AINV is expanded into a full matrix and -* multiplied by A, so the opposing triangle of AINV will be -* changed; i.e., if the upper triangular part of AINV is -* stored, the lower triangular part will be used as work space. -* -* LDAINV (input) INTEGER -* The leading dimension of the array AINV. LDAINV >= max(1,N). -* -* WORK (workspace) COMPLEX*16 array, dimension (LDWORK,N) -* -* LDWORK (input) INTEGER -* The leading dimension of the array WORK. LDWORK >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RCOND (output) DOUBLE PRECISION -* The reciprocal of the condition number of A, computed as -* ( 1/norm(A) ) / norm(AINV). -* -* RESID (output) DOUBLE PRECISION -* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), - $ CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, J - DOUBLE PRECISION AINVNM, ANORM, EPS -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANHE - EXTERNAL LSAME, DLAMCH, ZLANGE, ZLANHE -* .. -* .. External Subroutines .. - EXTERNAL ZHEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCONJG -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0. -* - IF( N.LE.0 ) THEN - RCOND = ONE - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) - AINVNM = ZLANHE( '1', UPLO, N, AINV, LDAINV, RWORK ) - IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN - RCOND = ZERO - RESID = ONE / EPS - RETURN - END IF - RCOND = ( ONE / ANORM ) / AINVNM -* -* Expand AINV into a full matrix and call ZHEMM to multiply -* AINV on the left by A. -* - IF( LSAME( UPLO, 'U' ) ) THEN - DO 20 J = 1, N - DO 10 I = 1, J - 1 - AINV( J, I ) = DCONJG( AINV( I, J ) ) - 10 CONTINUE - 20 CONTINUE - ELSE - DO 40 J = 1, N - DO 30 I = J + 1, N - AINV( J, I ) = DCONJG( AINV( I, J ) ) - 30 CONTINUE - 40 CONTINUE - END IF - CALL ZHEMM( 'Left', UPLO, N, N, -CONE, A, LDA, AINV, LDAINV, - $ CZERO, WORK, LDWORK ) -* -* Add the identity matrix to WORK . -* - DO 50 I = 1, N - WORK( I, I ) = WORK( I, I ) + CONE - 50 CONTINUE -* -* Compute norm(I - A*AINV) / (N * norm(A) * norm(AINV) * EPS) -* - RESID = ZLANGE( '1', N, N, WORK, LDWORK, RWORK ) -* - RESID = ( ( RESID*RCOND ) / EPS ) / DBLE( N ) -* - RETURN -* -* End of ZPOT03 -* - END diff --git a/testing/lin/zpot05.f b/testing/lin/zpot05.f deleted file mode 100644 index 759343b6d58dbced283c022f3f0b3b95eb3c9994..0000000000000000000000000000000000000000 --- a/testing/lin/zpot05.f +++ /dev/null @@ -1,252 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOT05( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, - $ LDXACT, FERR, BERR, RESLTS ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, LDXACT, N, NRHS -* .. -* .. Array Arguments .. - DOUBLE PRECISION BERR( * ), FERR( * ), RESLTS( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ), - $ XACT( LDXACT, * ) -* .. -* -* Purpose -* ======= -* -* ZPOT05 tests the error bounds from iterative refinement for the -* computed solution to a system of equations A*X = B, where A is a -* Hermitian n by n matrix. -* -* RESLTS(1) = test of the error bound -* = norm(X - XACT) / ( norm(X) * FERR ) -* -* A large value is returned if this ratio is not less than one. -* -* RESLTS(2) = residual from the iterative refinement routine -* = the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* Hermitian matrix A is stored. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows of the matrices X, B, and XACT, and the -* order of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X, B, and XACT. -* NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* 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. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* B (input) COMPLEX*16 array, dimension (LDB,NRHS) -* The right hand side vectors for the system of linear -* equations. -* -* LDB (input) INTEGER -* The leading dimension of the array B. LDB >= max(1,N). -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors. Each vector is stored as a -* column of the matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. LDX >= max(1,N). -* -* XACT (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The exact solution vectors. Each vector is stored as a -* column of the matrix XACT. -* -* LDXACT (input) INTEGER -* The leading dimension of the array XACT. LDXACT >= max(1,N). -* -* FERR (input) DOUBLE PRECISION array, dimension (NRHS) -* The estimated forward error bounds for each solution vector -* X. If XTRUE is the true solution, FERR bounds the magnitude -* of the largest entry in (X - XTRUE) divided by the magnitude -* of the largest entry in X. -* -* BERR (input) DOUBLE PRECISION array, dimension (NRHS) -* The componentwise relative backward error of each solution -* vector (i.e., the smallest relative change in any entry of A -* or B that makes X an exact solution). -* -* RESLTS (output) DOUBLE PRECISION array, dimension (2) -* The maximum over the NRHS solution vectors of the ratios: -* RESLTS(1) = norm(X - XACT) / ( norm(X) * FERR ) -* RESLTS(2) = BERR / ( (n+1)*EPS + (*) ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL UPPER - INTEGER I, IMAX, J, K - DOUBLE PRECISION AXBI, DIFF, EPS, ERRBND, OVFL, TMP, UNFL, XNORM - COMPLEX*16 ZDUM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IZAMAX - DOUBLE PRECISION DLAMCH - EXTERNAL LSAME, IZAMAX, DLAMCH -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX, MIN -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0. -* - IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RESLTS( 1 ) = ZERO - RESLTS( 2 ) = ZERO - RETURN - END IF -* - EPS = DLAMCH( 'Epsilon' ) - UNFL = DLAMCH( 'Safe minimum' ) - OVFL = ONE / UNFL - UPPER = LSAME( UPLO, 'U' ) -* -* Test 1: Compute the maximum of -* norm(X - XACT) / ( norm(X) * FERR ) -* over all the vectors X and XACT using the infinity-norm. -* - ERRBND = ZERO - DO 30 J = 1, NRHS - IMAX = IZAMAX( N, X( 1, J ), 1 ) - XNORM = MAX( CABS1( X( IMAX, J ) ), UNFL ) - DIFF = ZERO - DO 10 I = 1, N - DIFF = MAX( DIFF, CABS1( X( I, J )-XACT( I, J ) ) ) - 10 CONTINUE -* - IF( XNORM.GT.ONE ) THEN - GO TO 20 - ELSE IF( DIFF.LE.OVFL*XNORM ) THEN - GO TO 20 - ELSE - ERRBND = ONE / EPS - GO TO 30 - END IF -* - 20 CONTINUE - IF( DIFF / XNORM.LE.FERR( J ) ) THEN - ERRBND = MAX( ERRBND, ( DIFF / XNORM ) / FERR( J ) ) - ELSE - ERRBND = ONE / EPS - END IF - 30 CONTINUE - RESLTS( 1 ) = ERRBND -* -* Test 2: Compute the maximum of BERR / ( (n+1)*EPS + (*) ), where -* (*) = (n+1)*UNFL / (min_i (abs(A)*abs(X) +abs(b))_i ) -* - DO 90 K = 1, NRHS - DO 80 I = 1, N - TMP = CABS1( B( I, K ) ) - IF( UPPER ) THEN - DO 40 J = 1, I - 1 - TMP = TMP + CABS1( A( J, I ) )*CABS1( X( J, K ) ) - 40 CONTINUE - TMP = TMP + ABS( DBLE( A( I, I ) ) )*CABS1( X( I, K ) ) - DO 50 J = I + 1, N - TMP = TMP + CABS1( A( I, J ) )*CABS1( X( J, K ) ) - 50 CONTINUE - ELSE - DO 60 J = 1, I - 1 - TMP = TMP + CABS1( A( I, J ) )*CABS1( X( J, K ) ) - 60 CONTINUE - TMP = TMP + ABS( DBLE( A( I, I ) ) )*CABS1( X( I, K ) ) - DO 70 J = I + 1, N - TMP = TMP + CABS1( A( J, I ) )*CABS1( X( J, K ) ) - 70 CONTINUE - END IF - IF( I.EQ.1 ) THEN - AXBI = TMP - ELSE - AXBI = MIN( AXBI, TMP ) - END IF - 80 CONTINUE - TMP = BERR( K ) / ( ( N+1 )*EPS+( N+1 )*UNFL / - $ MAX( AXBI, ( N+1 )*UNFL ) ) - IF( K.EQ.1 ) THEN - RESLTS( 2 ) = TMP - ELSE - RESLTS( 2 ) = MAX( RESLTS( 2 ), TMP ) - END IF - 90 CONTINUE -* - RETURN -* -* End of ZPOT05 -* - END diff --git a/testing/lin/zpot06.f b/testing/lin/zpot06.f deleted file mode 100644 index 2d1d1b091a781c4c87fda9309c7672a41b83aee1..0000000000000000000000000000000000000000 --- a/testing/lin/zpot06.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* May 2007 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER LDA, LDB, LDX, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZPOT06 computes the residual for a solution of a system of linear -* equations A*x = b : -* RESID = norm(B - A*X,inf) / ( norm(A,inf) * norm(X,inf) * EPS ), -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the upper or lower triangular part of the -* symmetric matrix A is stored: -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* N (input) INTEGER -* The number of rows and columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,N). -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( norm(A) * norm(X) * EPS ). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, NEGONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - PARAMETER ( NEGONE = -1.0D+0 ) - COMPLEX*16 CONE, NEGCONE - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) - PARAMETER ( NEGCONE = ( -1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER IFAIL, J - DOUBLE PRECISION ANORM, BNORM, EPS, XNORM - COMPLEX*16 ZDUM -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER IZAMAX - DOUBLE PRECISION DLAMCH, ZLANSY - EXTERNAL LSAME, IZAMAX, DLAMCH, ZLANSY -* .. -* .. External Subroutines .. - EXTERNAL ZHEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX -* .. -* .. Statement Functions .. - DOUBLE PRECISION CABS1 -* .. -* .. Statement Function definitions .. - CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) -* .. -* .. -* .. Executable Statements .. -* -* Quick exit if N = 0 or NRHS = 0 -* - IF( N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* -* Exit with RESID = 1/EPS if ANORM = 0. -* - EPS = DLAMCH( 'Epsilon' ) - ANORM = ZLANSY( 'I', UPLO, N, A, LDA, RWORK ) - IF( ANORM.LE.ZERO ) THEN - RESID = ONE / EPS - RETURN - END IF -* -* Compute B - A*X and store in B. - IFAIL=0 -* - CALL ZHEMM( 'Left', UPLO, N, NRHS, NEGCONE, A, LDA, X, - $ LDX, CONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = CABS1(B(IZAMAX( N, B( 1, J ), 1 ),J)) - XNORM = CABS1(X(IZAMAX( N, X( 1, J ), 1 ),J)) - IF( XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) - END IF - 10 CONTINUE -* - RETURN -* -* End of ZPOT06 -* - END diff --git a/testing/lin/zpotri.f b/testing/lin/zpotri.f deleted file mode 100644 index ed9fd8dd6b494172b0f1143445e3e36011877368..0000000000000000000000000000000000000000 --- a/testing/lin/zpotri.f +++ /dev/null @@ -1,133 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZPOTRI( UPLO, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZPOTRI computes the inverse of a complex Hermitian positive definite -* matrix A using the Cholesky factorization A = U^H*U or A = L*L^H -* computed by ZPOTRF. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': Upper triangle of A is stored; -* = 'L': Lower triangle of A is stored. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the triangular factor U or L from the Cholesky -* factorization A = U^H*U or A = L*L^H, as computed by -* ZPOTRF. -* On exit, the upper or lower triangle of the (Hermitian) -* inverse of A, overwriting the input factor U or L. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, the (i,i) element of the factor U or L is -* zero, and the inverse could not be computed. -* -* ===================================================================== -* -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZLAUUM, ZTRTRI -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -4 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZPOTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Invert the triangular Cholesky factor U or L. -* - CALL ZTRTRI( UPLO, 'Non-unit', N, A, LDA, INFO ) - IF( INFO.GT.0 ) - $ RETURN -* -* Form inv(U)*inv(U)' or inv(L)'*inv(L). -* - CALL ZLAUUM( UPLO, N, A, LDA, INFO ) -* - RETURN -* -* End of ZPOTRI -* - END diff --git a/testing/lin/zqrt01.f b/testing/lin/zqrt01.f deleted file mode 100644 index 51707de43f2e81c105c6c7b1557f46588cb06d04..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt01.f +++ /dev/null @@ -1,196 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT01( M, N, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZQRT01 tests ZGEQRF, which computes the QR factorization of an m-by-n -* matrix A, and partially tests ZUNGQR which forms the m-by-m -* orthogonal matrix Q. -* -* ZQRT01 compares R with Q'*A, and checks that Q is orthogonal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The m-by-n matrix A. -* -* AF (output) COMPLEX*16 array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by ZGEQRF. -* See ZGEQRF for further details. -* -* Q (output) COMPLEX*16 array, dimension (LDA,M) -* The m-by-m orthogonal matrix Q. -* -* R (workspace) COMPLEX*16 array, dimension (LDA,max(M,N)) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. -* LDA >= max(M,N). -* -* TAU (output) COMPLEX*16 array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors, as returned -* by ZGEQRF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, MINMN - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY - EXTERNAL DLAMCH, ZLANGE, ZLANSY -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM, ZGEQRF, ZHERK, ZLACPY, ZLASET, ZUNGQR -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX, MIN -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - MINMN = MIN( M, N ) - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the matrix A to the array AF. -* - CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA ) -* -* Factorize the matrix A in the array AF. -* - SRNAMT = 'ZGEQRF' - CALL CHAMELEON_ZGEQRF( M, N, AF, LDA, T, INFO ) -* -* Copy details of Q -* - CALL ZLASET( 'Full', M, N, DCMPLX(ZERO), DCMPLX(ONE), Q, LDA ) -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'ZUNGQR' - CALL CHAMELEON_ZUNGQR( M, N, MINMN, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R -* - CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), DCMPLX( ZERO ), R, - $ LDA ) - CALL ZLACPY( 'Upper', N, N, AF, LDA, R, LDA ) -* -* Compute R - Q'*A -* - CALL ZGEMM( 'Conjugate transpose', 'No transpose', N, N, M, - $ DCMPLX( -ONE ), Q, LDA, A, LDA, DCMPLX( ONE ), R, - $ LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = ZLANGE( '1', M, N, A, LDA, RWORK ) - RESID = ZLANGE( '1', N, N, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), DCMPLX( ONE ), R, LDA ) - CALL ZHERK( 'Upper', 'Conjugate transpose', N, M, ONE, Q, LDA, - $ -ONE, R, LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = ZLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, N ) ) ) / EPS -* - RETURN -* -* End of ZQRT01 -* - END diff --git a/testing/lin/zqrt02.f b/testing/lin/zqrt02.f deleted file mode 100644 index f509bb188eff3a232392bb590cca0740e981a434..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt02.f +++ /dev/null @@ -1,192 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT02( M, N, K, A, AF, Q, R, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDA, * ), Q( LDA, * ), - $ R( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZQRT02 tests ZUNGQR, which generates an m-by-n matrix Q with -* orthonornmal columns that is defined as the product of k elementary -* reflectors. -* -* Given the QR factorization of an m-by-n matrix A, ZQRT02 generates -* the orthogonal matrix Q defined by the factorization of the first k -* columns of A; it compares R(1:n,1:k) with Q(1:m,1:n)'*A(1:m,1:k), -* and checks that the columns of Q are orthonormal. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The number of rows of the matrix Q to be generated. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix Q to be generated. -* M >= N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* matrix Q. N >= K >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The m-by-n matrix A which was factorized by ZQRT01. -* -* AF (input) COMPLEX*16 array, dimension (LDA,N) -* Details of the QR factorization of A, as returned by ZGEQRF. -* See ZGEQRF for further details. -* -* Q (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* R (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* LDA (input) INTEGER -* The leading dimension of the arrays A, AF, Q and R. LDA >= M. -* -* TAU (input) COMPLEX*16 array, dimension (N) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The dimension of the array WORK. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (2) -* The test ratios: -* RESULT(1) = norm( R - Q'*A ) / ( M * norm(A) * EPS ) -* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO - DOUBLE PRECISION ANORM, EPS, RESID -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY - EXTERNAL DLAMCH, ZLANGE, ZLANSY -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM, ZHERK, ZLACPY, ZLASET, ZUNGQR -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) -* -* Copy the first k columns of the factorization to the array Q -* - CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ONE ), Q, LDA ) -* -* Generate the first n columns of the matrix Q -* - SRNAMT = 'ZUNGQR' - CALL CHAMELEON_ZUNGQR( M, N, K, AF, LDA, T, Q, LDA, INFO ) -* -* Copy R(1:n,1:k) -* - CALL ZLASET( 'Full', N, K, DCMPLX( ZERO ), DCMPLX( ZERO ), R, - $ LDA ) - CALL ZLACPY( 'Upper', N, K, AF, LDA, R, LDA ) -* -* Compute R(1:n,1:k) - Q(1:m,1:n)' * A(1:m,1:k) -* - CALL ZGEMM( 'Conjugate transpose', 'No transpose', N, K, M, - $ DCMPLX( -ONE ), Q, LDA, A, LDA, DCMPLX( ONE ), R, - $ LDA ) -* -* Compute norm( R - Q'*A ) / ( M * norm(A) * EPS ) . -* - ANORM = ZLANGE( '1', M, K, A, LDA, RWORK ) - RESID = ZLANGE( '1', N, K, R, LDA, RWORK ) - IF( ANORM.GT.ZERO ) THEN - RESULT( 1 ) = ( ( RESID / DBLE( MAX( 1, M ) ) ) / ANORM ) / EPS - ELSE - RESULT( 1 ) = ZERO - END IF -* -* Compute I - Q'*Q -* - CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), DCMPLX( ONE ), R, LDA ) - CALL ZHERK( 'Upper', 'Conjugate transpose', N, M, -ONE, Q, LDA, - $ ONE, R, LDA ) -* -* Compute norm( I - Q'*Q ) / ( M * EPS ) . -* - RESID = ZLANSY( '1', 'Upper', N, R, LDA, RWORK ) -* - RESULT( 2 ) = ( RESID / DBLE( MAX( 1, M ) ) ) / EPS -* - RETURN -* -* End of ZQRT02 -* - END diff --git a/testing/lin/zqrt03.f b/testing/lin/zqrt03.f deleted file mode 100644 index 87e83acb2c27f56bd8647ad4bfaa16e5ef354535..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt03.f +++ /dev/null @@ -1,240 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK, - $ RWORK, RESULT ) -* - INCLUDE 'chameleon_fortran.h' -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER K, LDA, LWORK, M, N - INTEGER T( 2 ) -* .. -* .. Array Arguments .. - DOUBLE PRECISION RESULT( * ), RWORK( * ) - COMPLEX*16 AF( LDA, * ), C( LDA, * ), CC( LDA, * ), - $ Q( LDA, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZQRT03 tests ZUNMQR, which computes Q*C, Q'*C, C*Q or C*Q'. -* -* ZQRT03 compares the results of a call to ZUNMQR with the results of -* forming Q explicitly by a call to ZUNGQR and then performing matrix -* multiplication by a call to ZGEMM. -* -* Arguments -* ========= -* -* M (input) INTEGER -* The order of the orthogonal matrix Q. M >= 0. -* -* N (input) INTEGER -* The number of rows or columns of the matrix C; C is m-by-n if -* Q is applied from the left, or n-by-m if Q is applied from -* the right. N >= 0. -* -* K (input) INTEGER -* The number of elementary reflectors whose product defines the -* orthogonal matrix Q. M >= K >= 0. -* -* AF (input) COMPLEX*16 array, dimension (LDA,N) -* Details of the QR factorization of an m-by-n matrix, as -* returnedby ZGEQRF. See CGEQRF for further details. -* -* C (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* CC (workspace) COMPLEX*16 array, dimension (LDA,N) -* -* Q (workspace) COMPLEX*16 array, dimension (LDA,M) -* -* LDA (input) INTEGER -* The leading dimension of the arrays AF, C, CC, and Q. -* -* TAU (input) COMPLEX*16 array, dimension (min(M,N)) -* The scalar factors of the elementary reflectors corresponding -* to the QR factorization in AF. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of WORK. LWORK must be at least M, and should be -* M*NB, where NB is the blocksize for this environment. -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESULT (output) DOUBLE PRECISION array, dimension (4) -* The test ratios compare two techniques for multiplying a -* random matrix C by an m-by-m orthogonal matrix Q. -* RESULT(1) = norm( Q*C - Q*C ) / ( M * norm(C) * EPS ) -* RESULT(2) = norm( C*Q - C*Q ) / ( M * norm(C) * EPS ) -* RESULT(3) = norm( Q'*C - Q'*C )/ ( M * norm(C) * EPS ) -* RESULT(4) = norm( C*Q' - C*Q' )/ ( M * norm(C) * EPS ) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 ROGUE - PARAMETER ( ROGUE = ( -1.0D+10, -1.0D+10 ) ) -* .. -* .. Local Scalars .. - CHARACTER SIDE, TRANS - INTEGER INFO, ISIDE, ITRANS, J, MC, NC - INTEGER CHAMELEON_SIDE, CHAMELEON_TRANS - DOUBLE PRECISION CNORM, EPS, RESID -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLAMCH, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM, ZLACPY, ZLARNV, ZLASET, ZUNGQR, ZUNMQR -* .. -* .. Local Arrays .. - INTEGER ISEED( 4 ) -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Scalars in Common .. - CHARACTER*32 SRNAMT -* .. -* .. Common blocks .. - COMMON / SRNAMC / SRNAMT -* .. -* .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* .. -* .. Executable Statements .. -* - EPS = DLAMCH( 'Epsilon' ) - WORK(1) = ONE -* -* Copy the first k columns of the factorization to the array Q -* - IF ( K.EQ.0 ) THEN - CALL ZLASET( 'Full', M, M, ROGUE, ROGUE, Q, LDA ) - ELSE - CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ONE ), - $ Q, LDA ) - ENDIF -* -* Generate the m-by-m matrix Q -* - SRNAMT = 'ZUNGQR' - CALL CHAMELEON_ZUNGQR( M, M, K, AF, LDA, T, Q, LDA, INFO ) -* - DO 30 ISIDE = 1, 2 - IF( ISIDE.EQ.1 ) THEN - SIDE = 'L' - CHAMELEON_SIDE = CHAMELEONLEFT - MC = M - NC = N - ELSE - SIDE = 'R' - CHAMELEON_SIDE = CHAMELEONRIGHT - MC = N - NC = M - END IF -* -* Generate MC by NC matrix C -* - DO 10 J = 1, NC - CALL ZLARNV( 2, ISEED, MC, C( 1, J ) ) - 10 CONTINUE - CNORM = ZLANGE( '1', MC, NC, C, LDA, RWORK ) - IF( CNORM.EQ.ZERO ) - $ CNORM = ONE -* - DO 20 ITRANS = 1, 2 - IF( ITRANS.EQ.1 ) THEN - TRANS = 'N' - CHAMELEON_TRANS = CHAMELEONNOTRANS - ELSE - TRANS = 'C' - CHAMELEON_TRANS = CHAMELEONCONJTRANS - END IF -* -* Copy C -* - CALL ZLACPY( 'Full', MC, NC, C, LDA, CC, LDA ) -* -* Apply Q or Q' to C -* - SRNAMT = 'ZUNMQR' - CALL CHAMELEON_ZUNMQR( CHAMELEON_SIDE, CHAMELEON_TRANS, MC, NC, K, - $ AF, LDA, T, CC, LDA, INFO ) -* -* Form explicit product and subtract -* - IF ( K.EQ.0 ) THEN - CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), - $ DCMPLX( ONE ), Q, LDA ) - ENDIF - IF( LSAME( SIDE, 'L' ) ) THEN - CALL ZGEMM( TRANS, 'No transpose', MC, NC, MC, - $ DCMPLX( -ONE ), Q, LDA, C, LDA, - $ DCMPLX( ONE ), CC, LDA ) - ELSE - CALL ZGEMM( 'No transpose', TRANS, MC, NC, NC, - $ DCMPLX( -ONE ), C, LDA, Q, LDA, - $ DCMPLX( ONE ), CC, LDA ) - END IF -* -* Compute error in the difference -* - RESID = ZLANGE( '1', MC, NC, CC, LDA, RWORK ) - RESULT( ( ISIDE-1 )*2+ITRANS ) = RESID / - $ ( DBLE( MAX( 1, M ) )*CNORM*EPS ) -* - 20 CONTINUE - 30 CONTINUE -* - RETURN -* -* End of ZQRT03 -* - END diff --git a/testing/lin/zqrt13.f b/testing/lin/zqrt13.f deleted file mode 100644 index 434c068e8bccfcf5227b3417cf87c97e553d0873..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt13.f +++ /dev/null @@ -1,153 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, M, N, SCALE - DOUBLE PRECISION NORMA -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZQRT13 generates a full-rank matrix that may be scaled to have large -* or small norm. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* A (output) COMPLEX*16 array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* NORMA (output) DOUBLE PRECISION -* The one-norm of A. -* -* ISEED (input/output) integer array, dimension (4) -* Seed for random number generator -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE - PARAMETER ( ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, J - DOUBLE PRECISION BIGNUM, SMLNUM -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DZASUM, ZLANGE - EXTERNAL DLAMCH, DZASUM, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL DLABAD, ZLARNV, ZLASCL -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, SIGN -* .. -* .. Local Arrays .. - DOUBLE PRECISION DUMMY( 1 ) -* .. -* .. Executable Statements .. -* - IF( M.LE.0 .OR. N.LE.0 ) - $ RETURN -* -* benign matrix -* - DO 10 J = 1, N - CALL ZLARNV( 2, ISEED, M, A( 1, J ) ) - IF( J.LE.M ) THEN - A( J, J ) = A( J, J ) + DCMPLX( SIGN( DZASUM( M, A( 1, J ), - $ 1 ), DBLE( A( J, J ) ) ) ) - END IF - 10 CONTINUE -* -* scaled versions -* - IF( SCALE.NE.1 ) THEN - NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) - SMLNUM = SMLNUM / DLAMCH( 'Epsilon' ) - BIGNUM = ONE / SMLNUM -* - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA, - $ INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA, - $ INFO ) - END IF - END IF -* - NORMA = ZLANGE( 'One-norm', M, N, A, LDA, DUMMY ) - RETURN -* -* End of ZQRT13 -* - END diff --git a/testing/lin/zqrt14.f b/testing/lin/zqrt14.f deleted file mode 100644 index 2368dd5710d08b203b0771a2627ae6832c2b5cf5..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt14.f +++ /dev/null @@ -1,228 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION ZQRT14( TRANS, M, N, NRHS, A, LDA, X, - $ LDX, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZQRT14 checks whether X is in the row space of A or A'. It does so -* by scaling both X and A such that their norms are in the range -* [sqrt(eps), 1/sqrt(eps)], then computing a QR factorization of [A,X] -* (if TRANS = 'C') or an LQ factorization of [A',X]' (if TRANS = 'N'), -* and returning the norm of the trailing triangle, scaled by -* MAX(M,N,NRHS)*eps. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* = 'N': No transpose, check for X in the row space of A -* = 'C': Conjugate transpose, check for X in row space of A'. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* -* NRHS (input) INTEGER -* The number of right hand sides, i.e., the number of columns -* of X. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* If TRANS = 'N', the N-by-NRHS matrix X. -* IF TRANS = 'C', the M-by-NRHS matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* -* WORK (workspace) COMPLEX*16 array dimension (LWORK) -* -* LWORK (input) INTEGER -* length of workspace array required -* If TRANS = 'N', LWORK >= (M+NRHS)*(N+2); -* if TRANS = 'C', LWORK >= (N+NRHS)*(M+2). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - LOGICAL TPSD - INTEGER I, INFO, J, LDWORK - DOUBLE PRECISION ANRM, ERR, XNRM -* .. -* .. Local Arrays .. - DOUBLE PRECISION RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLAMCH, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGELQ2, ZGEQR2, ZLACPY, ZLASCL -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DCONJG, MAX, MIN -* .. -* .. Executable Statements .. -* - ZQRT14 = ZERO - IF( LSAME( TRANS, 'N' ) ) THEN - LDWORK = M + NRHS - TPSD = .FALSE. - IF( LWORK.LT.( M+NRHS )*( N+2 ) ) THEN - CALL XERBLA( 'ZQRT14', 10 ) - RETURN - ELSE IF( N.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE IF( LSAME( TRANS, 'C' ) ) THEN - LDWORK = M - TPSD = .TRUE. - IF( LWORK.LT.( N+NRHS )*( M+2 ) ) THEN - CALL XERBLA( 'ZQRT14', 10 ) - RETURN - ELSE IF( M.LE.0 .OR. NRHS.LE.0 ) THEN - RETURN - END IF - ELSE - CALL XERBLA( 'ZQRT14', 1 ) - RETURN - END IF -* -* Copy and scale A -* - CALL ZLACPY( 'All', M, N, A, LDA, WORK, LDWORK ) - ANRM = ZLANGE( 'M', M, N, WORK, LDWORK, RWORK ) - IF( ANRM.NE.ZERO ) - $ CALL ZLASCL( 'G', 0, 0, ANRM, ONE, M, N, WORK, LDWORK, INFO ) -* -* Copy X or X' into the right place and scale it -* - IF( TPSD ) THEN -* -* Copy X into columns n+1:n+nrhs of work -* - CALL ZLACPY( 'All', M, NRHS, X, LDX, WORK( N*LDWORK+1 ), - $ LDWORK ) - XNRM = ZLANGE( 'M', M, NRHS, WORK( N*LDWORK+1 ), LDWORK, - $ RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, M, NRHS, - $ WORK( N*LDWORK+1 ), LDWORK, INFO ) - ANRM = ZLANGE( 'One-norm', M, N+NRHS, WORK, LDWORK, RWORK ) -* -* Compute QR factorization of X -* - CALL ZGEQR2( M, N+NRHS, WORK, LDWORK, - $ WORK( LDWORK*( N+NRHS )+1 ), - $ WORK( LDWORK*( N+NRHS )+MIN( M, N+NRHS )+1 ), - $ INFO ) -* -* Compute largest entry in upper triangle of -* work(n+1:m,n+1:n+nrhs) -* - ERR = ZERO - DO 20 J = N + 1, N + NRHS - DO 10 I = N + 1, MIN( M, J ) - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*M ) ) ) - 10 CONTINUE - 20 CONTINUE -* - ELSE -* -* Copy X' into rows m+1:m+nrhs of work -* - DO 40 I = 1, N - DO 30 J = 1, NRHS - WORK( M+J+( I-1 )*LDWORK ) = DCONJG( X( I, J ) ) - 30 CONTINUE - 40 CONTINUE -* - XNRM = ZLANGE( 'M', NRHS, N, WORK( M+1 ), LDWORK, RWORK ) - IF( XNRM.NE.ZERO ) - $ CALL ZLASCL( 'G', 0, 0, XNRM, ONE, NRHS, N, WORK( M+1 ), - $ LDWORK, INFO ) -* -* Compute LQ factorization of work -* - CALL ZGELQ2( LDWORK, N, WORK, LDWORK, WORK( LDWORK*N+1 ), - $ WORK( LDWORK*( N+1 )+1 ), INFO ) -* -* Compute largest entry in lower triangle in -* work(m+1:m+nrhs,m+1:n) -* - ERR = ZERO - DO 60 J = M + 1, N - DO 50 I = J, LDWORK - ERR = MAX( ERR, ABS( WORK( I+( J-1 )*LDWORK ) ) ) - 50 CONTINUE - 60 CONTINUE -* - END IF -* - ZQRT14 = ERR / ( DBLE( MAX( M, N, NRHS ) )*DLAMCH( 'Epsilon' ) ) -* - RETURN -* -* End of ZQRT14 -* - END diff --git a/testing/lin/zqrt15.f b/testing/lin/zqrt15.f deleted file mode 100644 index 2f6fd84ba8ad00cfade4bfb329d3dc1cd02df386..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt15.f +++ /dev/null @@ -1,269 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, - $ RANK, NORMA, NORMB, ISEED, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - INTEGER LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE - DOUBLE PRECISION NORMA, NORMB -* .. -* .. Array Arguments .. - INTEGER ISEED( 4 ) - DOUBLE PRECISION S( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( LWORK ) -* .. -* -* Purpose -* ======= -* -* ZQRT15 generates a matrix with full or deficient rank and of various -* norms. -* -* Arguments -* ========= -* -* SCALE (input) INTEGER -* SCALE = 1: normally scaled matrix -* SCALE = 2: matrix scaled up -* SCALE = 3: matrix scaled down -* -* RKSEL (input) INTEGER -* RKSEL = 1: full rank matrix -* RKSEL = 2: rank-deficient matrix -* -* M (input) INTEGER -* The number of rows of the matrix A. -* -* N (input) INTEGER -* The number of columns of A. -* -* NRHS (input) INTEGER -* The number of columns of B. -* -* A (output) COMPLEX*16 array, dimension (LDA,N) -* The M-by-N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. -* -* B (output) COMPLEX*16 array, dimension (LDB, NRHS) -* A matrix that is in the range space of matrix A. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* -* S (output) DOUBLE PRECISION array, dimension MIN(M,N) -* Singular values of A. -* -* RANK (output) INTEGER -* number of nonzero singular values of A. -* -* NORMA (output) DOUBLE PRECISION -* one-norm norm of A. -* -* NORMB (output) DOUBLE PRECISION -* one-norm norm of B. -* -* ISEED (input/output) integer array, dimension (4) -* seed for random number generator. -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* length of work space required. -* LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M) -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TWO, SVMIN - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0, - $ SVMIN = 0.1D+0 ) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), - $ CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER INFO, J, MN - DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP -* .. -* .. Local Arrays .. - DOUBLE PRECISION DUMMY( 1 ) -* .. -* .. External Functions .. - DOUBLE PRECISION DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE - EXTERNAL DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL DLABAD, DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM, - $ ZLARF, ZLARNV, ZLAROR, ZLASCL, ZLASET -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, MAX, MIN -* .. -* .. Executable Statements .. -* - MN = MIN( M, N ) - IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN - CALL XERBLA( 'ZQRT15', 16 ) - RETURN - END IF -* - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) - EPS = DLAMCH( 'Epsilon' ) - SMLNUM = ( SMLNUM / EPS ) / EPS - BIGNUM = ONE / SMLNUM -* -* Determine rank and (unscaled) singular values -* - IF( RKSEL.EQ.1 ) THEN - RANK = MN - ELSE IF( RKSEL.EQ.2 ) THEN - RANK = ( 3*MN ) / 4 - DO 10 J = RANK + 1, MN - S( J ) = ZERO - 10 CONTINUE - ELSE - CALL XERBLA( 'ZQRT15', 2 ) - END IF -* - IF( RANK.GT.0 ) THEN -* -* Nontrivial case -* - S( 1 ) = ONE - DO 30 J = 2, RANK - 20 CONTINUE - TEMP = DLARND( 1, ISEED ) - IF( TEMP.GT.SVMIN ) THEN - S( J ) = ABS( TEMP ) - ELSE - GO TO 20 - END IF - 30 CONTINUE - CALL DLAORD( 'Decreasing', RANK, S, 1 ) -* -* Generate 'rank' columns of a random orthogonal matrix in A -* - CALL ZLARNV( 2, ISEED, M, WORK ) - CALL ZDSCAL( M, ONE / DZNRM2( M, WORK, 1 ), WORK, 1 ) - CALL ZLASET( 'Full', M, RANK, CZERO, CONE, A, LDA ) - CALL ZLARF( 'Left', M, RANK, WORK, 1, DCMPLX( TWO ), A, LDA, - $ WORK( M+1 ) ) -* -* workspace used: m+mn -* -* Generate consistent rhs in the range space of A -* - CALL ZLARNV( 2, ISEED, RANK*NRHS, WORK ) - CALL ZGEMM( 'No transpose', 'No transpose', M, NRHS, RANK, - $ CONE, A, LDA, WORK, RANK, CZERO, B, LDB ) -* -* work space used: <= mn *nrhs -* -* generate (unscaled) matrix A -* - DO 40 J = 1, RANK - CALL ZDSCAL( M, S( J ), A( 1, J ), 1 ) - 40 CONTINUE - IF( RANK.LT.N ) - $ CALL ZLASET( 'Full', M, N-RANK, CZERO, CZERO, - $ A( 1, RANK+1 ), LDA ) - CALL ZLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED, - $ WORK, INFO ) -* - ELSE -* -* work space used 2*n+m -* -* Generate null matrix and rhs -* - DO 50 J = 1, MN - S( J ) = ZERO - 50 CONTINUE - CALL ZLASET( 'Full', M, N, CZERO, CZERO, A, LDA ) - CALL ZLASET( 'Full', M, NRHS, CZERO, CZERO, B, LDB ) -* - END IF -* -* Scale the matrix -* - IF( SCALE.NE.1 ) THEN - NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY ) - IF( NORMA.NE.ZERO ) THEN - IF( SCALE.EQ.2 ) THEN -* -* matrix scaled up -* - CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, - $ LDA, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S, - $ MN, INFO ) - CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE IF( SCALE.EQ.3 ) THEN -* -* matrix scaled down -* - CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, - $ LDA, INFO ) - CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S, - $ MN, INFO ) - CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B, - $ LDB, INFO ) - ELSE - CALL XERBLA( 'ZQRT15', 1 ) - RETURN - END IF - END IF - END IF -* - NORMA = DASUM( MN, S, 1 ) - NORMB = ZLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY ) -* - RETURN -* -* End of ZQRT15 -* - END diff --git a/testing/lin/zqrt16.f b/testing/lin/zqrt16.f deleted file mode 100644 index 75a0f93d5173be7a5f0c253f8c4fe5ce3637556e..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt16.f +++ /dev/null @@ -1,182 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZQRT16( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, - $ RWORK, RESID ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER LDA, LDB, LDX, M, N, NRHS - DOUBLE PRECISION RESID -* .. -* .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) - COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZQRT16 computes the residual for a solution of a system of linear -* equations A*x = b or A'*x = b: -* RESID = norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* where EPS is the machine epsilon. -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies the form of the system of equations: -* = 'N': A *x = b -* = 'T': A^T*x = b, where A^T is the transpose of A -* = 'C': A^H*x = b, where A^H is the conjugate transpose of A -* -* M (input) INTEGER -* The number of rows of the matrix A. M >= 0. -* -* N (input) INTEGER -* The number of columns of the matrix A. N >= 0. -* -* NRHS (input) INTEGER -* The number of columns of B, the matrix of right hand sides. -* NRHS >= 0. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The original M x N matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,M). -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* The computed solution vectors for the system of linear -* equations. -* -* LDX (input) INTEGER -* The leading dimension of the array X. If TRANS = 'N', -* LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M). -* -* B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) -* On entry, the right hand side vectors for the system of -* linear equations. -* On exit, B is overwritten with the difference B - A*X. -* -* LDB (input) INTEGER -* The leading dimension of the array B. IF TRANS = 'N', -* LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). -* -* RWORK (workspace) DOUBLE PRECISION array, dimension (M) -* -* RESID (output) DOUBLE PRECISION -* The maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) - COMPLEX*16 CONE - PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER J, N1, N2 - DOUBLE PRECISION ANORM, BNORM, EPS, XNORM, RHSNORM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DZASUM, ZLANGE - EXTERNAL LSAME, DLAMCH, DZASUM, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL ZGEMM -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Quick exit if M = 0 or N = 0 or NRHS = 0 -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN - RESID = ZERO - RETURN - END IF -* - IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN - ANORM = ZLANGE( 'I', M, N, A, LDA, RWORK ) - N1 = N - N2 = M - ELSE - ANORM = ZLANGE( '1', M, N, A, LDA, RWORK ) - N1 = M - N2 = N - END IF - RHSNORM = ZLANGE( 'I', N, NRHS, B, LDB, RWORK ) -* - EPS = DLAMCH( 'Epsilon' ) -* -* Compute B - A*X (or B - A'*X ) and store in B. -* - CALL ZGEMM( TRANS, 'No transpose', N1, NRHS, N2, -CONE, A, LDA, X, - $ LDX, CONE, B, LDB ) -* -* Compute the maximum over the number of right hand sides of -* norm(B - A*X) / ( max(m,n) * (norm(A) * norm(X)+ nnorm (RHS)) * EPS ) . -* - RESID = ZERO - DO 10 J = 1, NRHS - BNORM = DZASUM( N1, B( 1, J ), 1 ) - XNORM = DZASUM( N2, X( 1, J ), 1 ) - IF( ANORM.EQ.ZERO .AND. BNORM.EQ.ZERO ) THEN - RESID = ZERO - ELSE IF( ANORM.LE.ZERO .OR. XNORM.LE.ZERO ) THEN - RESID = ONE / EPS - ELSE - RESID = MAX( RESID, ( BNORM )/ (ANORM *XNORM + RHSNORM ) * - $ ( MAX( M, N )*EPS ) ) - END IF - 10 CONTINUE -* - RETURN -* -* End of ZQRT16 -* - END diff --git a/testing/lin/zqrt17.f b/testing/lin/zqrt17.f deleted file mode 100644 index 2a3e4b5d88980e597db63ca0f565f3ef981cf8a4..0000000000000000000000000000000000000000 --- a/testing/lin/zqrt17.f +++ /dev/null @@ -1,218 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - DOUBLE PRECISION FUNCTION ZQRT17( TRANS, IRESID, M, N, NRHS, A, - $ LDA, X, LDX, B, LDB, C, WORK, LWORK ) -* -* -- LAPACK test routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER TRANS - INTEGER IRESID, LDA, LDB, LDX, LWORK, M, N, NRHS -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDB, * ), - $ WORK( LWORK ), X( LDX, * ) -* .. -* -* Purpose -* ======= -* -* ZQRT17 computes the ratio -* -* || R'*op(A) ||/(||A||*alpha*max(M,N,NRHS)*eps) -* -* where R = op(A)*X - B, op(A) is A or A', and -* -* alpha = ||B|| if IRESID = 1 (zero-residual problem) -* alpha = ||R|| if IRESID = 2 (otherwise). -* -* Arguments -* ========= -* -* TRANS (input) CHARACTER*1 -* Specifies whether or not the transpose of A is used. -* = 'N': No transpose, op(A) = A. -* = 'C': Conjugate transpose, op(A) = A'. -* -* IRESID (input) INTEGER -* IRESID = 1 indicates zero-residual problem. -* IRESID = 2 indicates non-zero residual. -* -* M (input) INTEGER -* The number of rows of the matrix A. -* If TRANS = 'N', the number of rows of the matrix B. -* If TRANS = 'C', the number of rows of the matrix X. -* -* N (input) INTEGER -* The number of columns of the matrix A. -* If TRANS = 'N', the number of rows of the matrix X. -* If TRANS = 'C', the number of rows of the matrix B. -* -* NRHS (input) INTEGER -* The number of columns of the matrices X and B. -* -* A (input) COMPLEX*16 array, dimension (LDA,N) -* The m-by-n matrix A. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= M. -* -* X (input) COMPLEX*16 array, dimension (LDX,NRHS) -* If TRANS = 'N', the n-by-nrhs matrix X. -* If TRANS = 'C', the m-by-nrhs matrix X. -* -* LDX (input) INTEGER -* The leading dimension of the array X. -* If TRANS = 'N', LDX >= N. -* If TRANS = 'C', LDX >= M. -* -* B (input) COMPLEX*16 array, dimension (LDB,NRHS) -* If TRANS = 'N', the m-by-nrhs matrix B. -* If TRANS = 'C', the n-by-nrhs matrix B. -* -* LDB (input) INTEGER -* The leading dimension of the array B. -* If TRANS = 'N', LDB >= M. -* If TRANS = 'C', LDB >= N. -* -* C (workspace) COMPLEX*16 array, dimension (LDB,NRHS) -* -* WORK (workspace) COMPLEX*16 array, dimension (LWORK) -* -* LWORK (input) INTEGER -* The length of the array WORK. LWORK >= NRHS*(M+N). -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - INTEGER INFO, ISCL, NCOLS, NROWS - DOUBLE PRECISION BIGNUM, ERR, NORMA, NORMB, NORMRS, NORMX, - $ SMLNUM -* .. -* .. Local Arrays .. - DOUBLE PRECISION RWORK( 1 ) -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLAMCH, ZLANGE -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZLACPY, ZLASCL -* .. -* .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, MAX -* .. -* .. Executable Statements .. -* - ZQRT17 = ZERO -* - IF( LSAME( TRANS, 'N' ) ) THEN - NROWS = M - NCOLS = N - ELSE IF( LSAME( TRANS, 'C' ) ) THEN - NROWS = N - NCOLS = M - ELSE - CALL XERBLA( 'ZQRT17', 1 ) - RETURN - END IF -* - IF( LWORK.LT.NCOLS*NRHS ) THEN - CALL XERBLA( 'ZQRT17', 13 ) - RETURN - END IF -* - IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.LE.0 ) - $ RETURN -* - NORMA = ZLANGE( 'One-norm', M, N, A, LDA, RWORK ) - SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) - BIGNUM = ONE / SMLNUM - ISCL = 0 -* -* compute residual and scale it -* - CALL ZLACPY( 'All', NROWS, NRHS, B, LDB, C, LDB ) - CALL ZGEMM( TRANS, 'No transpose', NROWS, NRHS, NCOLS, - $ DCMPLX( -ONE ), A, LDA, X, LDX, DCMPLX( ONE ), C, - $ LDB ) - NORMRS = ZLANGE( 'Max', NROWS, NRHS, C, LDB, RWORK ) - IF( NORMRS.GT.SMLNUM ) THEN - ISCL = 1 - CALL ZLASCL( 'General', 0, 0, NORMRS, ONE, NROWS, NRHS, C, LDB, - $ INFO ) - END IF -* -* compute R'*A -* - CALL ZGEMM( 'Conjugate transpose', TRANS, NRHS, NCOLS, NROWS, - $ DCMPLX( ONE ), C, LDB, A, LDA, DCMPLX( ZERO ), WORK, - $ NRHS ) -* -* compute and properly scale error -* - ERR = ZLANGE( 'One-norm', NRHS, NCOLS, WORK, NRHS, RWORK ) - IF( NORMA.NE.ZERO ) - $ ERR = ERR / NORMA -* - IF( ISCL.EQ.1 ) - $ ERR = ERR*NORMRS -* - IF( IRESID.EQ.1 ) THEN - NORMB = ZLANGE( 'One-norm', NROWS, NRHS, B, LDB, RWORK ) - IF( NORMB.NE.ZERO ) - $ ERR = ERR / NORMB - ELSE - NORMX = ZLANGE( 'One-norm', NCOLS, NRHS, X, LDX, RWORK ) - IF( NORMX.NE.ZERO ) - $ ERR = ERR / NORMX - END IF -* - ZQRT17 = ERR / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N, NRHS ) ) ) - RETURN -* -* End of ZQRT17 -* - END diff --git a/testing/lin/zsbmv.f b/testing/lin/zsbmv.f deleted file mode 100644 index 1a8b9abe8c584b5612f20812780aad1cc8e2d9f5..0000000000000000000000000000000000000000 --- a/testing/lin/zsbmv.f +++ /dev/null @@ -1,343 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, - $ INCY ) -* -* -- LAPACK auxiliary routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, K, LDA, N - COMPLEX*16 ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* ZSBMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric band matrix, with k super-diagonals. -* -* Arguments -* ========== -* -* UPLO - CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the band matrix A is being supplied as -* follows: -* -* UPLO = 'U' or 'u' The upper triangular part of A is -* being supplied. -* -* UPLO = 'L' or 'l' The lower triangular part of A is -* being supplied. -* -* Unchanged on exit. -* -* N - INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* K - INTEGER -* On entry, K specifies the number of super-diagonals of the -* matrix A. K must satisfy 0 .le. K. -* Unchanged on exit. -* -* ALPHA - COMPLEX*16 -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* A - COMPLEX*16 array, dimension( LDA, N ) -* Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) -* by n part of the array A must contain the upper triangular -* band part of the symmetric matrix, supplied column by -* column, with the leading diagonal of the matrix in row -* ( k + 1 ) of the array, the first super-diagonal starting at -* position 2 in row k, and so on. The top left k by k triangle -* of the array A is not referenced. -* The following program segment will transfer the upper -* triangular part of a symmetric band matrix from conventional -* full matrix storage to band storage: -* -* DO 20, J = 1, N -* M = K + 1 - J -* DO 10, I = MAX( 1, J - K ), J -* A( M + I, J ) = matrix( I, J ) -* 10 CONTINUE -* 20 CONTINUE -* -* Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) -* by n part of the array A must contain the lower triangular -* band part of the symmetric matrix, supplied column by -* column, with the leading diagonal of the matrix in row 1 of -* the array, the first sub-diagonal starting at position 1 in -* row 2, and so on. The bottom right k by k triangle of the -* array A is not referenced. -* The following program segment will transfer the lower -* triangular part of a symmetric band matrix from conventional -* full matrix storage to band storage: -* -* DO 20, J = 1, N -* M = 1 - J -* DO 10, I = J, MIN( N, J + K ) -* A( M + I, J ) = matrix( I, J ) -* 10 CONTINUE -* 20 CONTINUE -* -* Unchanged on exit. -* -* LDA - INTEGER -* On entry, LDA specifies the first dimension of A as declared -* in the calling (sub) program. LDA must be at least -* ( k + 1 ). -* Unchanged on exit. -* -* X - COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the -* vector x. -* Unchanged on exit. -* -* INCX - INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA - COMPLEX*16 -* On entry, BETA specifies the scalar beta. -* Unchanged on exit. -* -* Y - COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the -* vector y. On exit, Y is overwritten by the updated vector y. -* -* INCY - INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) - COMPLEX*16 ZERO - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L - COMPLEX*16 TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( K.LT.0 ) THEN - INFO = 3 - ELSE IF( LDA.LT.( K+1 ) ) THEN - INFO = 6 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 8 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 11 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZSBMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of the array A -* are accessed sequentially with one pass through A. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when upper triangle of A is stored. -* - KPLUS1 = K + 1 - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - L = KPLUS1 - J - DO 50 I = MAX( 1, J-K ), J - 1 - Y( I ) = Y( I ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( I ) - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - L = KPLUS1 - J - DO 70 I = MAX( 1, J-K ), J - 1 - Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - IF( J.GT.K ) THEN - KX = KX + INCX - KY = KY + INCY - END IF - 80 CONTINUE - END IF - ELSE -* -* Form y when lower triangle of A is stored. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*A( 1, J ) - L = 1 - J - DO 90 I = J + 1, MIN( N, J+K ) - Y( I ) = Y( I ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( I ) - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*A( 1, J ) - L = 1 - J - IX = JX - IY = JY - DO 110 I = J + 1, MIN( N, J+K ) - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) - TEMP2 = TEMP2 + A( L+I, J )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZSBMV -* - END diff --git a/testing/lin/zspmv.f b/testing/lin/zspmv.f deleted file mode 100644 index 2254a86307066bcd1f949f4e5117b505f8bd777e..0000000000000000000000000000000000000000 --- a/testing/lin/zspmv.f +++ /dev/null @@ -1,302 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, N - COMPLEX*16 ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX*16 AP( * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* ZSPMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric matrix, supplied in packed form. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the matrix A is supplied in the packed -* array AP as follows: -* -* UPLO = 'U' or 'u' The upper triangular part of A is -* supplied in AP. -* -* UPLO = 'L' or 'l' The lower triangular part of A is -* supplied in AP. -* -* Unchanged on exit. -* -* N (input) INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* ALPHA (input) COMPLEX*16 -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* AP (input) COMPLEX*16 array, dimension at least -* ( ( N*( N + 1 ) )/2 ). -* Before entry, with UPLO = 'U' or 'u', the array AP must -* contain the upper triangular part of the symmetric matrix -* packed sequentially, column by column, so that AP( 1 ) -* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) -* and a( 2, 2 ) respectively, and so on. -* Before entry, with UPLO = 'L' or 'l', the array AP must -* contain the lower triangular part of the symmetric matrix -* packed sequentially, column by column, so that AP( 1 ) -* contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) -* and a( 3, 1 ) respectively, and so on. -* Unchanged on exit. -* -* X (input) COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the N- -* element vector x. -* Unchanged on exit. -* -* INCX (input) INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA (input) COMPLEX*16 -* On entry, BETA specifies the scalar beta. When BETA is -* supplied as zero then Y need not be set on input. -* Unchanged on exit. -* -* Y (input/output) COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the n -* element vector y. On exit, Y is overwritten by the updated -* vector y. -* -* INCY (input) INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) - COMPLEX*16 ZERO - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY - COMPLEX*16 TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 6 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 9 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZSPMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of the array AP -* are accessed sequentially with one pass through AP. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - KK = 1 - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when AP contains the upper triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - K = KK - DO 50 I = 1, J - 1 - Y( I ) = Y( I ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( I ) - K = K + 1 - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2 - KK = KK + J - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - DO 70 K = KK, KK + J - 2 - Y( IY ) = Y( IY ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - KK = KK + J - 80 CONTINUE - END IF - ELSE -* -* Form y when AP contains the lower triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*AP( KK ) - K = KK + 1 - DO 90 I = J + 1, N - Y( I ) = Y( I ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( I ) - K = K + 1 - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - KK = KK + ( N-J+1 ) - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*AP( KK ) - IX = JX - IY = JY - DO 110 K = KK + 1, KK + N - J - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*AP( K ) - TEMP2 = TEMP2 + AP( K )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - KK = KK + ( N-J+1 ) - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZSPMV -* - END diff --git a/testing/lin/zsymv.f b/testing/lin/zsymv.f deleted file mode 100644 index 7c14e0be157df1c9d35d73a8506a4af549ffa7a0..0000000000000000000000000000000000000000 --- a/testing/lin/zsymv.f +++ /dev/null @@ -1,302 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) -* -* -- LAPACK auxiliary routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER UPLO - INTEGER INCX, INCY, LDA, N - COMPLEX*16 ALPHA, BETA -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), X( * ), Y( * ) -* .. -* -* Purpose -* ======= -* -* ZSYMV performs the matrix-vector operation -* -* y := alpha*A*x + beta*y, -* -* where alpha and beta are scalars, x and y are n element vectors and -* A is an n by n symmetric matrix. -* -* Arguments -* ========== -* -* UPLO (input) CHARACTER*1 -* On entry, UPLO specifies whether the upper or lower -* triangular part of the array A is to be referenced as -* follows: -* -* UPLO = 'U' or 'u' Only the upper triangular part of A -* is to be referenced. -* -* UPLO = 'L' or 'l' Only the lower triangular part of A -* is to be referenced. -* -* Unchanged on exit. -* -* N (input) INTEGER -* On entry, N specifies the order of the matrix A. -* N must be at least zero. -* Unchanged on exit. -* -* ALPHA (input) COMPLEX*16 -* On entry, ALPHA specifies the scalar alpha. -* Unchanged on exit. -* -* A (input) COMPLEX*16 array, dimension ( LDA, N ) -* Before entry, with UPLO = 'U' or 'u', the leading n by n -* upper triangular part of the array A must contain the upper -* triangular part of the symmetric matrix and the strictly -* lower triangular part of A is not referenced. -* Before entry, with UPLO = 'L' or 'l', the leading n by n -* lower triangular part of the array A must contain the lower -* triangular part of the symmetric matrix and the strictly -* upper triangular part of A is not referenced. -* Unchanged on exit. -* -* LDA (input) INTEGER -* On entry, LDA specifies the first dimension of A as declared -* in the calling (sub) program. LDA must be at least -* max( 1, N ). -* Unchanged on exit. -* -* X (input) COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCX ) ). -* Before entry, the incremented array X must contain the N- -* element vector x. -* Unchanged on exit. -* -* INCX (input) INTEGER -* On entry, INCX specifies the increment for the elements of -* X. INCX must not be zero. -* Unchanged on exit. -* -* BETA (input) COMPLEX*16 -* On entry, BETA specifies the scalar beta. When BETA is -* supplied as zero then Y need not be set on input. -* Unchanged on exit. -* -* Y (input/output) COMPLEX*16 array, dimension at least -* ( 1 + ( N - 1 )*abs( INCY ) ). -* Before entry, the incremented array Y must contain the n -* element vector y. On exit, Y is overwritten by the updated -* vector y. -* -* INCY (input) INTEGER -* On entry, INCY specifies the increment for the elements of -* Y. INCY must not be zero. -* Unchanged on exit. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) - COMPLEX*16 ZERO - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY - COMPLEX*16 TEMP1, TEMP2 -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = 1 - ELSE IF( N.LT.0 ) THEN - INFO = 2 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = 5 - ELSE IF( INCX.EQ.0 ) THEN - INFO = 7 - ELSE IF( INCY.EQ.0 ) THEN - INFO = 10 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZSYMV ', INFO ) - RETURN - END IF -* -* Quick return if possible. -* - IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) - $ RETURN -* -* Set up the start points in X and Y. -* - IF( INCX.GT.0 ) THEN - KX = 1 - ELSE - KX = 1 - ( N-1 )*INCX - END IF - IF( INCY.GT.0 ) THEN - KY = 1 - ELSE - KY = 1 - ( N-1 )*INCY - END IF -* -* Start the operations. In this version the elements of A are -* accessed sequentially with one pass through the triangular part -* of A. -* -* First form y := beta*y. -* - IF( BETA.NE.ONE ) THEN - IF( INCY.EQ.1 ) THEN - IF( BETA.EQ.ZERO ) THEN - DO 10 I = 1, N - Y( I ) = ZERO - 10 CONTINUE - ELSE - DO 20 I = 1, N - Y( I ) = BETA*Y( I ) - 20 CONTINUE - END IF - ELSE - IY = KY - IF( BETA.EQ.ZERO ) THEN - DO 30 I = 1, N - Y( IY ) = ZERO - IY = IY + INCY - 30 CONTINUE - ELSE - DO 40 I = 1, N - Y( IY ) = BETA*Y( IY ) - IY = IY + INCY - 40 CONTINUE - END IF - END IF - END IF - IF( ALPHA.EQ.ZERO ) - $ RETURN - IF( LSAME( UPLO, 'U' ) ) THEN -* -* Form y when A is stored in upper triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 60 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - DO 50 I = 1, J - 1 - Y( I ) = Y( I ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( I ) - 50 CONTINUE - Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2 - 60 CONTINUE - ELSE - JX = KX - JY = KY - DO 80 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - IX = KX - IY = KY - DO 70 I = 1, J - 1 - Y( IY ) = Y( IY ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( IX ) - IX = IX + INCX - IY = IY + INCY - 70 CONTINUE - Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 80 CONTINUE - END IF - ELSE -* -* Form y when A is stored in lower triangle. -* - IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN - DO 100 J = 1, N - TEMP1 = ALPHA*X( J ) - TEMP2 = ZERO - Y( J ) = Y( J ) + TEMP1*A( J, J ) - DO 90 I = J + 1, N - Y( I ) = Y( I ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( I ) - 90 CONTINUE - Y( J ) = Y( J ) + ALPHA*TEMP2 - 100 CONTINUE - ELSE - JX = KX - JY = KY - DO 120 J = 1, N - TEMP1 = ALPHA*X( JX ) - TEMP2 = ZERO - Y( JY ) = Y( JY ) + TEMP1*A( J, J ) - IX = JX - IY = JY - DO 110 I = J + 1, N - IX = IX + INCX - IY = IY + INCY - Y( IY ) = Y( IY ) + TEMP1*A( I, J ) - TEMP2 = TEMP2 + A( I, J )*X( IX ) - 110 CONTINUE - Y( JY ) = Y( JY ) + ALPHA*TEMP2 - JX = JX + INCX - JY = JY + INCY - 120 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZSYMV -* - END diff --git a/testing/lin/ztest.in b/testing/lin/ztest.in deleted file mode 100644 index 9051ffc39abe9588f85f7edb906d35ce63db853c..0000000000000000000000000000000000000000 --- a/testing/lin/ztest.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing DOUBLE PRECISION COMPLEX CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -0 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -ZGE 11 List types on next line if 0 < NTYPES < 11 -ZPO 9 List types on next line if 0 < NTYPES < 9 -ZLS 6 List types on next line if 0 < NTYPES < 6 -ZQR 8 List types on next line if 0 < NTYPES < 8 -ZLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/ztestdyn.in b/testing/lin/ztestdyn.in deleted file mode 100644 index 2355cfd98434693db3374ef3696b22050dd7d9cf..0000000000000000000000000000000000000000 --- a/testing/lin/ztestdyn.in +++ /dev/null @@ -1,25 +0,0 @@ -Data file for testing DOUBLE PRECISION COMPLEX CHAMELEON linear eqn. routines -1 Number of values of NP -2 Values of NP (number of cores) -1 Values of SCHED (0: Static, 1:Dynamic) -10 Number of values of M -0 1 2 5 8 17 23 97 211 407 Values of M (row dimension) -10 Number of values of N -0 1 2 5 8 17 23 97 211 407 Values of N (column dimension) -3 Number of values of NRHS -1 2 15 Values of NRHS (number of right hand sides) -5 Number of values of NB -1 2 10 20 50 Values of NB (the tile size) -1 2 5 10 10 Values of IB (the inner block size) -1 0 5 9 1 Values of NX (crossover point) -3 Number of values of RANK -30 50 90 Values of rank (as a % of N) -60.0 Threshold value of test ratio -T Put T to test the CHAMELEON routines -T Put T to test the driver routines -T Put T to test the error exits -ZGE 11 List types on next line if 0 < NTYPES < 11 -ZPO 9 List types on next line if 0 < NTYPES < 9 -ZLS 6 List types on next line if 0 < NTYPES < 6 -ZQR 8 List types on next line if 0 < NTYPES < 8 -ZLQ 8 List types on next line if 0 < NTYPES < 8 diff --git a/testing/lin/ztrti2.f b/testing/lin/ztrti2.f deleted file mode 100644 index adc7a51087cfb7cd6b5320a1b20b76305ef72d42..0000000000000000000000000000000000000000 --- a/testing/lin/ztrti2.f +++ /dev/null @@ -1,184 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZTRTI2 computes the inverse of a complex upper or lower triangular -* matrix. -* -* This is the Level 2 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* Specifies whether the matrix A is upper or lower triangular. -* = 'U': Upper triangular -* = 'L': Lower triangular -* -* DIAG (input) CHARACTER*1 -* Specifies whether or not the matrix A is unit triangular. -* = 'N': Non-unit triangular -* = 'U': Unit triangular -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading n by n upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading n by n lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -k, the k-th argument had an illegal value -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J - COMPLEX*16 AJJ -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZSCAL, ZTRMV -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZTRTI2', -INFO ) - RETURN - END IF -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix. -* - DO 10 J = 1, N - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF -* -* Compute elements 1:j-1 of j-th column. -* - CALL ZTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA, - $ A( 1, J ), 1 ) - CALL ZSCAL( J-1, AJJ, A( 1, J ), 1 ) - 10 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix. -* - DO 20 J = N, 1, -1 - IF( NOUNIT ) THEN - A( J, J ) = ONE / A( J, J ) - AJJ = -A( J, J ) - ELSE - AJJ = -ONE - END IF - IF( J.LT.N ) THEN -* -* Compute elements j+1:n of j-th column. -* - CALL ZTRMV( 'Lower', 'No transpose', DIAG, N-J, - $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) - CALL ZSCAL( N-J, AJJ, A( J+1, J ), 1 ) - END IF - 20 CONTINUE - END IF -* - RETURN -* -* End of ZTRTI2 -* - END diff --git a/testing/lin/ztrtri.f b/testing/lin/ztrtri.f deleted file mode 100644 index d955f854d54047c74ad73db346f28bda108d1aef..0000000000000000000000000000000000000000 --- a/testing/lin/ztrtri.f +++ /dev/null @@ -1,215 +0,0 @@ -!!! -! -! -- Inria -! -- (C) Copyright 2012 -! -! This software is a computer program whose purpose is to process -! Matrices Over Runtime Systems @ Exascale (MORSE). More information -! can be found on the following website: http://www.inria.fr/en/teams/morse. -! -! This software is governed by the CeCILL-B license under French law and -! abiding by the rules of distribution of free software. You can use, -! modify and/ or redistribute the software under the terms of the CeCILL-B -! license as circulated by CEA, CNRS and INRIA at the following URL -! "http://www.cecill.info". -! -! As a counterpart to the access to the source code and rights to copy, -! modify and redistribute granted by the license, users are provided only -! with a limited warranty and the software's author, the holder of the -! economic rights, and the successive licensors have only limited -! liability. -! -! In this respect, the user's attention is drawn to the risks associated -! with loading, using, modifying and/or developing or reproducing the -! software by the user in light of its specific status of free software, -! that may mean that it is complicated to manipulate, and that also -! therefore means that it is reserved for developers and experienced -! professionals having in-depth computer knowledge. Users are therefore -! encouraged to load and test the software's suitability as regards their -! requirements in conditions enabling the security of their systems and/or -! data to be ensured and, more generally, to use and operate it in the -! same conditions as regards security. -! -! The fact that you are presently reading this means that you have had -! knowledge of the CeCILL-B license and that you accept its terms. -! -!!! - - SUBROUTINE ZTRTRI( UPLO, DIAG, N, A, LDA, INFO ) -* -* -- LAPACK routine (version 3.2) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER DIAG, UPLO - INTEGER INFO, LDA, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ) -* .. -* -* Purpose -* ======= -* -* ZTRTRI computes the inverse of a complex upper or lower triangular -* matrix A. -* -* This is the Level 3 BLAS version of the algorithm. -* -* Arguments -* ========= -* -* UPLO (input) CHARACTER*1 -* = 'U': A is upper triangular; -* = 'L': A is lower triangular. -* -* DIAG (input) CHARACTER*1 -* = 'N': A is non-unit triangular; -* = 'U': A is unit triangular. -* -* N (input) INTEGER -* The order of the matrix A. N >= 0. -* -* A (input/output) COMPLEX*16 array, dimension (LDA,N) -* On entry, the triangular matrix A. If UPLO = 'U', the -* leading N-by-N upper triangular part of the array A contains -* the upper triangular matrix, and the strictly lower -* triangular part of A is not referenced. If UPLO = 'L', the -* leading N-by-N lower triangular part of the array A contains -* the lower triangular matrix, and the strictly upper -* triangular part of A is not referenced. If DIAG = 'U', the -* diagonal elements of A are also not referenced and are -* assumed to be 1. -* On exit, the (triangular) inverse of the original matrix, in -* the same storage format. -* -* LDA (input) INTEGER -* The leading dimension of the array A. LDA >= max(1,N). -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* > 0: if INFO = i, A(i,i) is exactly zero. The triangular -* matrix is singular and its inverse can not be computed. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE, ZERO - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL NOUNIT, UPPER - INTEGER J, JB, NB, NN -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAENV - EXTERNAL LSAME, ILAENV -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZTRMM, ZTRSM, ZTRTI2 -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* -* Test the input parameters. -* - INFO = 0 - UPPER = LSAME( UPLO, 'U' ) - NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN - INFO = -1 - ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -5 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZTRTRI', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.0 ) - $ RETURN -* -* Check for singularity if non-unit. -* - IF( NOUNIT ) THEN - DO 10 INFO = 1, N - IF( A( INFO, INFO ).EQ.ZERO ) - $ RETURN - 10 CONTINUE - INFO = 0 - END IF -* -* Determine the block size for this environment. -* - NB = ILAENV( 1, 'ZTRTRI', UPLO // DIAG, N, -1, -1, -1 ) - IF( NB.LE.1 .OR. NB.GE.N ) THEN -* -* Use unblocked code -* - CALL ZTRTI2( UPLO, DIAG, N, A, LDA, INFO ) - ELSE -* -* Use blocked code -* - IF( UPPER ) THEN -* -* Compute inverse of upper triangular matrix -* - DO 20 J = 1, N, NB - JB = MIN( NB, N-J+1 ) -* -* Compute rows 1:j-1 of current block column -* - CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, - $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, - $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) -* -* Compute inverse of current diagonal block -* - CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) - 20 CONTINUE - ELSE -* -* Compute inverse of lower triangular matrix -* - NN = ( ( N-1 ) / NB )*NB + 1 - DO 30 J = NN, 1, -NB - JB = MIN( NB, N-J+1 ) - IF( J+JB.LE.N ) THEN -* -* Compute rows j+jb:n of current block column -* - CALL ZTRMM( 'Left', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, - $ A( J+JB, J ), LDA ) - CALL ZTRSM( 'Right', 'Lower', 'No transpose', DIAG, - $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, - $ A( J+JB, J ), LDA ) - END IF -* -* Compute inverse of current diagonal block -* - CALL ZTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) - 30 CONTINUE - END IF - END IF -* - RETURN -* -* End of ZTRTRI -* - END diff --git a/new-testing/parameters.c b/testing/parameters.c similarity index 98% rename from new-testing/parameters.c rename to testing/parameters.c index 5e8e1ff2ee8324d9c557da9a1e7ecd2ef690087e..8b437b68b8791a5e17cb5798c01275c505ceff3b 100644 --- a/new-testing/parameters.c +++ b/testing/parameters.c @@ -2,15 +2,15 @@ * * @file parameters.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. *** * * @brief Chameleon auxiliary routines for testing structures * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-18 + * @date 2020-03-03 * */ #include "testings.h" diff --git a/new-testing/run_list.c b/testing/run_list.c similarity index 99% rename from new-testing/run_list.c rename to testing/run_list.c index 9c8a3e99e7fc6d3a8a4b3bb1c167f2e9ce83d049..d572a24fae661d31e8164a3539e7dd49da2bee94 100644 --- a/new-testing/run_list.c +++ b/testing/run_list.c @@ -2,15 +2,15 @@ * * @file run_list.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. *** * * @brief Chameleon auxiliary routines for testing structures * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-18 + * @date 2020-03-03 * */ #include "testings.h" diff --git a/testing/testing_dgram.c b/testing/testing_dgram.c deleted file mode 100644 index 4aefca6e2efdf035cd7e982f4c405cbf3725015d..0000000000000000000000000000000000000000 --- a/testing/testing_dgram.c +++ /dev/null @@ -1,260 +0,0 @@ -/** - * - * @file testing_dgram.c - * - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon dgram testing - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Florent Pruvost - * @date 2019-04-12 - * @precisions normal d -> d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" -#if defined(CHAMELEON_USE_MPI) -#include <mpi.h> -#endif - -static int check_solution(cham_uplo_t uplo, - int N, - double *Aref, - double *Acham, int LDA); -static int compute_gram_sequential(cham_uplo_t uplo, - int N, - double *A, - int LDA); - -int testing_dgram(int argc, char **argv) -{ - int hres = 0; - /* Check for number of arguments */ - if ( argc < 2) { - USAGE("GRAM", "N LDA", - " - N : number of rows of matrix A\n" - " - LDA : leading dimension of matrix A\n"); - return -1; - } - int N = atoi(argv[0]); - int LDA = atoi(argv[1]); - - double eps; - int info_solution; - int i, j, ua; - int LDAxN = LDA*N; - - double *A = (double *)malloc(LDAxN*sizeof(double)); - double *Aref = (double *)malloc(LDAxN*sizeof(double)); - double *Acham = (double *)malloc(LDAxN*sizeof(double)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!Aref) || (!Acham) ) - { - free(A); free(Aref); free(Acham); - printf("Out of Memory \n "); - return -2; - } - - eps = LAPACKE_dlamch_work('e'); - - if (CHAMELEON_Comm_rank() == 0){ - printf("\n"); - printf("------ TESTS FOR CHAMELEON GRAM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - } - - /*---------------------------------------------------------- - * TESTING GRAM - */ - - /* Initialize A such that it is symmetric */ - CHAMELEON_dplgsy( (double)N, ChamUpperLower, N, A, LDA, 51 ); - /* Gram is meant to be used with A full of positive values only */ -#if defined(PRECISION_d) || defined(PRECISION_s) - for (i=0; i<N; i++) { - for (j=0; j<N; j++) { - if ( A[i+j*LDA] < 0. ) { - A[i+j*LDA] = -A[i+j*LDA]; - } - } - } -#endif - - for (ua=0; ua<3; ua++) { - CHAMELEON_dlacpy( ChamUpperLower, N, N, A, LDA, Aref, LDA ); - CHAMELEON_dlacpy( ChamUpperLower, N, N, A, LDA, Acham, LDA ); - - /* CHAMELEON GRAM */ - CHAMELEON_dgram(uplo[ua], N, Acham, LDA); - - /* Check the solution */ - info_solution = check_solution(uplo[ua], N, Aref, Acham, LDA); - - if (CHAMELEON_Comm_rank() == 0){ - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING GRAM (%s) ............... PASSED !\n", uplostr[ua]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING GRAM (%s) ... FAILED !\n", uplostr[ua]); hres++; - printf("************************************************\n"); - } - } - } - free(A); free(Aref); free(Acham); - - return hres; -} - -/*-------------------------------------------------------------- - * Check the solution - */ -static int check_solution(cham_uplo_t uplo, - int N, - double *Aref, - double *Acham, int LDA) -{ - int info_solution; - double Arefnorm, Rnorm, result; - double eps; - double mdone; - - double *work = (double *)malloc(N * sizeof(double)); - - mdone = -1.0; - - /* - * Compute the Gram matrix sequentially - * we consider the matrix on entry as symmetric - */ - compute_gram_sequential(uplo, N, Aref, LDA); - - /* Compute norm of Aref to scale the result norm */ - if (uplo == ChamUpperLower) { - Arefnorm = LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'I', - N, N, Aref, LDA, work); - } else { - Arefnorm = LAPACKE_dlantr_work(LAPACK_COL_MAJOR, 'I', - chameleon_lapack_const(uplo), chameleon_lapack_const(ChamNonUnit), - N, N, Aref, LDA, work); - } - /* compute the difference Aref = Aref - Acham */ - cblas_daxpy(LDA*N, mdone, Acham, 1, Aref, 1); - - /* compute the norm of the difference */ - if (uplo == ChamUpperLower) { - Rnorm = LAPACKE_dlange_work(LAPACK_COL_MAJOR, 'I', - N, N, Aref, LDA, work); - } else { - Rnorm = LAPACKE_dlantr_work(LAPACK_COL_MAJOR, 'I', - chameleon_lapack_const(uplo), chameleon_lapack_const(ChamNonUnit), - N, N, Aref, LDA, work); - } - - eps = LAPACKE_dlamch_work('e'); - if (CHAMELEON_Comm_rank() == 0) - printf("Rnorm %e, Anorm %e\n", Rnorm, Arefnorm); - - /* scale the norm in respect to Aref */ - result = Rnorm / (Arefnorm * N * eps); - - if (CHAMELEON_Comm_rank() == 0){ - printf("============\n"); - printf("Checking the norm of the difference against reference GRAM \n"); - printf("-- ||Acham - Aref||_oo/((||Aref||_oo.N.eps) = %e \n", - result); - } - - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - if (CHAMELEON_Comm_rank() == 0) - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - if (CHAMELEON_Comm_rank() == 0) - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; -} - -/*-------------------------------------------------------------- - * Compute the Gram matrix sequentially - * We consider the matrix on entry as symmetric - */ -static int compute_gram_sequential(cham_uplo_t uplo, - int N, - double *A, - int LDA) -{ - int m, n; - double squareij, mean_dij, mhalf; - - double *work = (double *)malloc(N * sizeof(double)); - - mhalf = -0.5; - - /* initialize work */ - memset(work, 0., N*sizeof(double)); - - /* first: compute the means of squares */ - for (n=0; n<N; n++) { - int mmin = ( uplo == ChamLower ) ? n : 0; - int mmax = ( uplo == ChamUpper ) ? chameleon_min(n+1, N) : N; - for (m = mmin; m < mmax; m++) { - squareij = A[m+n*LDA]*A[m+n*LDA]; - /* accumulate squares on columns */ - work[n] += squareij; - if ( m != n && uplo != ChamUpperLower ) { - /* accumulate squares on the symmetric part */ - work[m] += squareij; - } - } - } - mean_dij = 0.; - for (n=0; n<N; n++) { - /* accumulate the squares over the entire matrix */ - mean_dij += work[n]; - /* compute the mean on each column */ - work[n] /= N; - } - /* compute the global mean */ - mean_dij /= N*N; - /* second: compute the Gram matrix factors */ - for (n=0; n<N; n++) { - int mmin = ( uplo == ChamLower ) ? n : 0; - int mmax = ( uplo == ChamUpper ) ? chameleon_min(n+1, N) : N; - for (m = mmin; m < mmax; m++) { - squareij = A[m+n*LDA]*A[m+n*LDA]; - A[m+n*LDA] = mhalf*( squareij - work[m] - work[n] + mean_dij ); - } - } - - free(work); - - return 0; -} diff --git a/testing/testing_zauxiliary.c b/testing/testing_zauxiliary.c deleted file mode 100644 index 525edc553c5e9247f8a899f5567540df52b0d07d..0000000000000000000000000000000000000000 --- a/testing/testing_zauxiliary.c +++ /dev/null @@ -1,336 +0,0 @@ -/** - * - * @file testing_zauxiliary.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings routines - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Cédric Castagnède - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#if defined( _WIN32 ) || defined( _WIN64 ) -#include <windows.h> -#else /* Non-Windows */ -#include <unistd.h> -#include <sys/resource.h> -#endif -#include <chameleon.h> -#include "testing_zauxiliary.h" - -int IONE = 1; -int ISEED[4] = {0,0,0,1}; /* initial seed for zlarnv() */ - -cham_storage_t format[6] = { ChamCM, ChamRM, ChamCCRB, ChamCRRB, ChamRCRB, ChamRRRB }; -cham_side_t side[2] = { ChamLeft, ChamRight }; -cham_uplo_t uplo[3] = { ChamUpper, ChamLower, ChamUpperLower }; -cham_diag_t diag[2] = { ChamNonUnit, ChamUnit }; -cham_trans_t trans[3] = { ChamNoTrans, ChamTrans, ChamConjTrans }; -int itype[3] = { 1, 2, 3 }; -cham_store_t storev[2] = { ChamRowwise, ChamColumnwise }; -cham_normtype_t norm[4] = { ChamMaxNorm, ChamOneNorm, ChamInfNorm, ChamFrobeniusNorm }; - -char *formatstr[6]= { "CM", "RM", "CCRB", "CRRB", "RCRB", "RRRB"}; -char *sidestr[2] = { "Left ", "Right" }; -char *uplostr[3] = { "Upper", "Lower", "UpperLower" }; -char *diagstr[2] = { "NonUnit", "Unit " }; -char *transstr[3] = { "N", "T", "H" }; -char *itypestr[3] = { "inv(U')xAxinv(U) or inv(L)xAxinv(L')", "UxAxU' or L'xAxL", "UxAxU' or L'xAxL" }; -char *storevstr[2] = { "Rowwise", "Columnwise" }; -char *normstr[4] = { "Max", "One", "Inf", "Fro" }; - -#define map_cm(m, n, i, j) ((i) + (j) * (m)) -#define map_rm(m, n, i, j) ((i) * (n) + (j)) - -int map_CM(int m, int n, int mb, int nb, int i, int j) -{ - int hres = map_cm(m, n, i, j); - (void)mb; - (void)nb; - (void)n; - return hres; -} - -int map_RM(int m, int n, int mb, int nb, int i, int j) -{ - int hres = map_rm(m, n, i, j); - (void)mb; - (void)nb; - (void)m; - return hres; -} - -int map_CCRB(int m, int n, int mb, int nb, int i, int j) { - int m0 = m - m%mb; - int n0 = n - n%nb; - if ( j < n0 ) - if (i < m0) - /* Case in A11 */ - return ( map_cm( m/mb, n/nb, i/mb, j/nb )*mb*nb + map_cm( mb, nb, i%mb, j%nb) ); - else - /* Case in A21 */ - return ( m0*n0 + ( (j/nb) * (nb*(m%mb)) ) + map_cm( m%mb, nb, i%mb, j%nb) ); - else - if (i < m0) - /* Case in A12 */ - return ( m*n0 + ( (i/mb) * (mb*(n%nb)) ) + map_cm( mb, n%nb, i%mb, j%nb) ); - else - /* Case in A22 */ - return ( m*n0 + (n-n0)*m0 + map_cm( m%mb, n%nb, i%mb, j%nb) ); -} - -int map_CRRB(int m, int n, int mb, int nb, int i, int j) { - int m0 = m - m%mb; - int n0 = n - n%nb; - if ( j < n0 ) - if (i < m0) - /* Case in A11 */ - return ( map_cm( m/mb, n/nb, i/mb, j/nb )*mb*nb + map_rm( mb, nb, i%mb, j%nb) ); - else - /* Case in A21 */ - return ( m0*n0 + ( (j/nb) * (nb*(m%mb)) ) + map_rm( m%mb, nb, i%mb, j%nb) ); - else - if (i < m0) - /* Case in A12 */ - return ( m*n0 + ( (i/mb) * (mb*(n%nb)) ) + map_rm( mb, n%nb, i%mb, j%nb) ); - else - /* Case in A22 */ - return ( m*n0 + (n-n0)*m0 + map_rm( m%mb, n%nb, i%mb, j%nb) ); -} - -int map_RCRB(int m, int n, int mb, int nb, int i, int j) { - int m0 = m - m%mb; - int n0 = n - n%nb; - if ( j < n0 ) - if (i < m0) - /* Case in A11 */ - return ( map_rm( m/mb, n/nb, i/mb, j/nb )*mb*nb + map_cm( mb, nb, i%mb, j%nb) ); - else - /* Case in A21 */ - return ( m0*n + ( (j/nb) * (nb*(m%mb)) ) + map_cm( m%mb, nb, i%mb, j%nb) ); - else - if (i < m0) - /* Case in A12 */ - return ( m0*n0 + ( (i/mb) * (mb*(n%nb)) ) + map_cm( mb, n%nb, i%mb, j%nb) ); - else - /* Case in A22 */ - return ( m*n0 + (n-n0)*m0 + map_cm( m%mb, n%nb, i%mb, j%nb) ); -} - -int map_RRRB(int m, int n, int mb, int nb, int i, int j) { - int m0 = m - m%mb; - int n0 = n - n%nb; - if ( j < n0 ) - if (i < m0) - /* Case in A11 */ - return ( map_rm( m/mb, n/nb, i/mb, j/nb )*mb*nb + map_rm( mb, nb, i%mb, j%nb) ); - else - /* Case in A21 */ - return ( m0*n + ( (j/nb) * (nb*(m%mb)) ) + map_rm( m%mb, nb, i%mb, j%nb) ); - else - if (i < m0) - /* Case in A12 */ - return ( m0*n0 + ( (i/mb) * (mb*(n%nb)) ) + map_rm( mb, n%nb, i%mb, j%nb) ); - else - /* Case in A22 */ - return ( m*n0 + (n-n0)*m0 + map_rm( m%mb, n%nb, i%mb, j%nb) ); -} - -int (*formatmap[6])(int, int, int, int, int, int) = { map_CM, map_RM, map_CCRB, map_CRRB, map_RCRB, map_RRRB }; - -int main (int argc, char **argv) -{ - int ncores, ngpus, nb, ib; - int info = 0; - char func[32]; - - /* Check for number of arguments*/ - if ( argc < 6 ) { - printf(" Proper Usage is : ./ztesting ncores ngpus nb ib FUNC ...\n" - " - ncores : number of cores\n" - " - ngpus : number of GPUs\n" - " - nb : define the tile size\n" - " - ib : define the inner tile size\n" - " - FUNC : name of function to test\n" - " - ... plus arguments depending on the testing function \n"); - exit(1); - } - - sscanf( argv[1], "%d", &ncores ); - sscanf( argv[2], "%d", &ngpus ); - sscanf( argv[3], "%d", &nb ); - sscanf( argv[4], "%d", &ib ); - sscanf( argv[5], "%31s", func ); - - /* Initialize CHAMELEON */ - /*if(nthreads_per_worker) - CHAMELEON_InitPar(ncores/nthreads_per_worker, ncudas, nthreads_per_worker); - else*/ - CHAMELEON_Init( ncores, ngpus); - CHAMELEON_Disable(CHAMELEON_AUTOTUNING); - CHAMELEON_Set(CHAMELEON_TILE_SIZE, nb ); - CHAMELEON_Set(CHAMELEON_INNER_BLOCK_SIZE, ib ); - CHAMELEON_user_tag_size( 64, 54 ); - - argc -= 6; - argv += 6; - info = 0; - - /* - * Norms - */ - if ( strcmp(func, "LANGE") == 0 ) { - info += testing_zlange( argc, argv ); - } - /* - * Blas Level 3 - */ - else if ( strcmp(func, "GEMM") == 0 ) { - info += testing_zgemm( argc, argv ); - } -#if defined(PRECISION_z) || defined(PRECISION_c) - else if ( strcmp(func, "HEMM") == 0 ) { - info += testing_zhemm( argc, argv ); - } - else if ( strcmp(func, "HERK") == 0 ) { - info += testing_zherk( argc, argv ); - } - else if ( strcmp(func, "HER2K") == 0 ) { - info += testing_zher2k( argc, argv ); - } -#endif - else if ( strcmp(func, "SYMM") == 0 ) { - info += testing_zsymm( argc, argv ); - } - else if ( strcmp(func, "SYRK") == 0 ) { - info += testing_zsyrk( argc, argv ); - } - else if ( strcmp(func, "SYR2K") == 0 ) { - info += testing_zsyr2k( argc, argv ); - } - else if ( strcmp(func, "TRMM") == 0 ) { - info += testing_ztrmm( argc, argv ); - } - else if ( strcmp(func, "TRSM") == 0 ) { - info += testing_ztrsm( argc, argv ); - } - else if ( strcmp(func, "PEMV") == 0 ) { - info += testing_zpemv( argc, argv ); - } - else if ( strcmp(func, "GEADD") == 0 ) { - info = testing_zgeadd( argc, argv ); - } - /* - * Linear system - */ - else if ( strcmp(func, "POSV") == 0 ) { - info += testing_zposv( argc, argv ); - } - else if ( strcmp(func, "GELS") == 0 ) { - info += testing_zgels( argc, argv ); - } - else if ( strcmp(func, "GESV_INCPIV") == 0 ) { - info += testing_zgesv_incpiv( argc, argv ); - } - else if ( strcmp(func, "GELS_HQR") == 0 ) { - info += testing_zgels_hqr( argc, argv ); - } - else if ( strcmp(func, "GELS_SYSTOLIC") == 0 ) { - info += testing_zgels_systolic( argc, argv ); - } - /* else if ( strcmp(func, "GESV") == 0 ) { */ - /* info += testing_zgesv( argc, argv ); */ - /* } */ - /* - * Matrix inversion - */ - else if ( strcmp(func, "POTRI") == 0 ) { - info += testing_zpotri( argc, argv ); - } - /* else if ( strcmp(func, "GETRI") == 0 ) { */ - /* info += testing_zgetri( argc, argv ); */ - /* } */ - /* - * Eigenvalue Problems - */ - /* else if ( strcmp(func, "HEEV") == 0 ) { */ - /* info += testing_zheev( argc, argv ); */ - /* } */ - else if ( strcmp(func, "HEEVD") == 0 ) { - info += testing_zheevd( argc, argv ); - } - /* else if ( strcmp(func, "HEGV") == 0 ) { */ - /* info += testing_zhegv( argc, argv ); */ - /* } */ - /* else if ( strcmp(func, "HEGVD") == 0 ) { */ - /* info += testing_zhegv( argc, argv ); */ - /* } */ - /* else if ( strcmp(func, "HEGST") == 0 ) { */ - /* info += testing_zhegst( argc, argv ); */ - /* } */ - /* - * Singular Value Decomposition - */ - else if ( strcmp(func, "GESVD") == 0 ) { - info += testing_zgesvd( argc, argv ); - } -#ifdef DOUBLE - /* - * Mixed precision - */ - /* else if ( strcmp(func, "CPOSV") == 0 ) { */ - /* info += testing_zcposv( argc, argv ); */ - /* } */ - /* else if ( strcmp(func, "CGESV") == 0 ) { */ - /* info += testing_zcgesv( argc, argv ); */ - /* } */ - /* else if ( strcmp(func, "CUNGESV") == 0 ) { */ - /* info += testing_zcungesv( argc, argv ); */ - /* } */ -#endif - /* - * Layout Transformation - */ - /* else if ( strcmp(func, "GECFI") == 0 ) { */ - /* info += testing_zgecfi( argc, argv ); */ - /* } */ - /* else if ( strcmp(func, "GETMI") == 0 ) { */ - /* info += testing_zgetmi( argc, argv ); */ - /* } */ - else if ( strcmp(func, "GEQRF_QDWH") == 0 ) { - info += testing_zgeqrf_qdwh( argc, argv ); - } - /* - * Gram Matrix - */ -#if defined(PRECISION_d) || defined(PRECISION_s) - else if ( strcmp(func, "GRAM") == 0 ) { - info += testing_zgram( argc, argv ); - } -#endif - else { - fprintf(stderr, "Function unknown\n"); - } - - if ( info == -1 ) { - printf( "TESTING %s FAILED : incorrect number of arguments\n", func); - } else if ( info == -2 ) { - printf( "TESTING %s FAILED : not enough memory\n", func); - } - - CHAMELEON_Finalize(); - - return info; -} diff --git a/testing/testing_zauxiliary.h b/testing/testing_zauxiliary.h deleted file mode 100644 index efc0fa2cc49ff89e47d234b37cd1bddf188e6537..0000000000000000000000000000000000000000 --- a/testing/testing_zauxiliary.h +++ /dev/null @@ -1,120 +0,0 @@ -/** - * - * @file testing_zauxiliary.h - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings header - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Cédric Castagnède - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#ifndef _testing_zauxiliary_h_ -#define _testing_zauxiliary_h_ - -//#include "testing.h" - -#define USAGE(name, args, details) \ - printf(" Proper Usage is : ./ztesting ncores ngpus nb ib " name " " args " with\n" \ - " - ncores : number of cores\n" \ - " - ngpus : number of GPUs\n" \ - " - nb : define the tile size\n" \ - " - ib : define the inner tile size\n" \ - " - FUNC : name of function to test\n" \ - details); - -#ifdef WIN32 -#include <float.h> -#define isnan _isnan -#endif - -#ifndef max -#define max(a, b) ((a) > (b) ? (a) : (b)) -#endif -#ifndef min -#define min(a, b) ((a) < (b) ? (a) : (b)) -#endif - -extern int IONE; -extern int ISEED[4]; - -extern cham_storage_t format[6]; -extern cham_trans_t trans[3]; -extern cham_uplo_t uplo[3]; -extern cham_side_t side[2]; -extern cham_diag_t diag[2]; -extern int itype[3]; -extern cham_store_t storev[2]; -extern cham_normtype_t norm[4]; - -extern char *formatstr[6]; -extern char *transstr[3]; -extern char *uplostr[3]; -extern char *sidestr[2]; -extern char *diagstr[2]; -extern char *itypestr[3]; -extern char *storevstr[2]; -extern char *normstr[4]; - -extern int (*formatmap[6])(int, int, int, int, int, int); - -int map_CM (int m, int n, int mb, int nb, int i, int j); -int map_CCRB(int m, int n, int mb, int nb, int i, int j); -int map_CRRB(int m, int n, int mb, int nb, int i, int j); -int map_RCRB(int m, int n, int mb, int nb, int i, int j); -int map_RRRB(int m, int n, int mb, int nb, int i, int j); -int map_RM (int m, int n, int mb, int nb, int i, int j); - -int testing_zgemm(int argc, char **argv); -int testing_zhemm(int argc, char **argv); -int testing_zsymm(int argc, char **argv); -int testing_zherk(int argc, char **argv); -int testing_zlange(int argc, char **argv); -int testing_zsyrk(int argc, char **argv); -int testing_zher2k(int argc, char **argv); -int testing_zsyr2k(int argc, char **argv); -int testing_ztrmm(int argc, char **argv); -int testing_ztrsm(int argc, char **argv); -int testing_zpemv(int argc, char **argv); -int testing_zgeadd(int argc, char **argv); - -int testing_zposv(int argc, char **argv); -int testing_zgels(int argc, char **argv); -int testing_zgels_hqr(int argc, char **argv); -int testing_zgels_systolic(int argc, char **argv); -int testing_zgesv(int argc, char **argv); -int testing_zgesv_incpiv(int argc, char **argv); - -int testing_zpotri(int argc, char **argv); -int testing_zgetri(int argc, char **argv); - -int testing_zgeev(int argc, char **argv); -int testing_zgesvd(int argc, char **argv); -int testing_zheev(int argc, char **argv); -int testing_zheevd(int argc, char **argv); -int testing_zhegv(int argc, char **argv); -int testing_zhegst(int argc, char **argv); - -int testing_zgecfi(int argc, char **argv); -int testing_zgetmi(int argc, char **argv); - -int testing_zgeqrf_qdwh(int argc, char **argv); - -#ifdef DOUBLE -int testing_zcposv(int argc, char **argv); -int testing_zcgesv(int argc, char **argv); -int testing_zcungesv(int argc, char **argv); -#endif - -int testing_zgram(int argc, char **argv); - -#endif /* _testing_zauxiliary_h_ */ diff --git a/new-testing/testing_zcheck.c b/testing/testing_zcheck.c similarity index 99% rename from new-testing/testing_zcheck.c rename to testing/testing_zcheck.c index 66d2289aa5721e7d5147508f3140927834a6134e..a5e2a73690db37b01f39d030214ac9bddef7f35a 100644 --- a/new-testing/testing_zcheck.c +++ b/testing/testing_zcheck.c @@ -9,9 +9,9 @@ * * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings routines * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ @@ -31,7 +31,7 @@ #include <mpi.h> #endif #include "../control/common.h" -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" diff --git a/new-testing/testing_zcheck.h b/testing/testing_zcheck.h similarity index 98% rename from new-testing/testing_zcheck.h rename to testing/testing_zcheck.h index e03346267c6570edf8d1b2c7a685111942edbd34..312e3f5e3a783fd4e9bcb6602bac91ff1a66515a 100644 --- a/new-testing/testing_zcheck.h +++ b/testing/testing_zcheck.h @@ -2,16 +2,16 @@ * * @file testing_zcheck.h * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon CHAMELEON_Complex64_t auxiliary testings header * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ @@ -96,5 +96,4 @@ int check_zqc ( run_arg_list_t *args, cham_side_t side, cham_trans_t t #endif /* defined(CHAMELEON_SIMULATION) */ -#endif - +#endif /* _testing_zcheck_h_ */ diff --git a/testing/testing_zgeadd.c b/testing/testing_zgeadd.c index 47fb94f94ea0665969ee17e19701ebc4a276d182..ec0e40e79002a429284665b676fca9a65799ff31 100644 --- a/testing/testing_zgeadd.c +++ b/testing/testing_zgeadd.c @@ -2,322 +2,132 @@ * * @file testing_zgeadd.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeadd testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2015-11-03 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" -#if defined(CHAMELEON_USE_MPI) -#include <mpi.h> -#endif +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -static int check_tr_solution(cham_uplo_t uplo, cham_trans_t trans, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB); -static int check_ge_solution(cham_trans_t trans, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB); - -int testing_zgeadd(int argc, char **argv) +static cham_fixdbl_t +flops_zgeadd( int M, int N ) { - /* Check for number of arguments*/ - if ( argc != 6 ) { - USAGE("GEADD", "alpha beta M N LDA LDB", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - M : number of rows of matrices A and C\n" - " - N : number of columns of matrices B and C\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n" ); - return -1; - } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int M = atoi(argv[2]); - int N = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDB = atoi(argv[5]); - - double eps; - int info_solution; - int t, u; - int LDAxN = LDA*max(M,N); - int LDBxN = LDB*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Binit = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Bfinal = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!Binit) || (!Bfinal) ) - { - free(A); free(B); - free(Binit); free(Bfinal); - printf("Out of Memory \n "); - return -2; - } - - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEADD ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrices A and B are randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZGEADD - */ - - /* Initialize A, B */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - -#if defined(PRECISION_z) || defined(PRECISION_c) - for (t=0; t<3; t++) { -#else - for (t=0; t<2; t++) { -#endif - memcpy( Binit, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - memcpy( Bfinal, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZGEADD */ - CHAMELEON_zgeadd(trans[t], M, N, alpha, A, LDA, beta, Bfinal, LDB); - - /* Check the solution */ - info_solution = check_ge_solution(trans[t], M, N, - alpha, A, LDA, - beta, Binit, Bfinal, LDB); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEADD (%s) ............... PASSED !\n", transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZGEADD (%s) ... FAILED !\n", transstr[t]); - printf("************************************************\n"); - } - } -#ifdef _UNUSED_ - } -#endif - - /*---------------------------------------------------------- - * TESTING TRADD - */ - - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - -#if defined(PRECISION_z) || defined(PRECISION_c) - for (t=0; t<3; t++) { + cham_fixdbl_t flops = 0.; +#if defined( PRECISION_z ) || defined( PRECISION_c ) + /* 2 multiplications and 1 addition per element */ + flops = ( 2. * 6. + 2. ) * M * N; #else - for (t=0; t<2; t++) { -#endif - for (u=0; u<2; u++) { - memcpy( Binit, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - memcpy( Bfinal, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZGEADD */ - CHAMELEON_ztradd(uplo[u], trans[t], M, N, alpha, A, LDA, beta, Bfinal, LDB); - - /* Check the solution */ - info_solution = check_tr_solution(uplo[u], trans[t], M, N, - alpha, A, LDA, - beta, Binit, Bfinal, LDB); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZTRADD (%s, %s) ............... PASSED !\n", uplostr[u], transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZTRADD (%s, %s) ... FAILED !\n", uplostr[u], transstr[t]); - printf("************************************************\n"); - } - } - } -#ifdef _UNUSED_ - } + flops = ( 2. + 1. ) * M * N; #endif - free(A); free(B); - free(Binit); free(Bfinal); - - return 0; + return flops; } -/*-------------------------------------------------------------- - * Check the solution - */ - -static int check_tr_solution(cham_uplo_t uplo, cham_trans_t trans, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB) +int +testing_zgeadd( run_arg_list_t *args, int check ) { - int info_solution; - double Anorm, Binitnorm, Bchamnorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t mzone; - - double *work = (double *)malloc(max(M, N)* sizeof(double)); - int Am, An; - - mzone = -1.0; - - if (trans == ChamNoTrans) { - Am = M; An = N; - } else { - Am = N; An = M; - } - - /* if ( ((trans == ChamNoTrans) && (uplo == ChamLower)) || */ - /* ((trans != ChamNoTrans) && (uplo == ChamUpper)) ) */ - /* { */ - /* Anorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', 'L', 'N', */ - /* Am, An, A, LDA, work); */ - /* } */ - /* else */ - /* { */ - /* Anorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', 'U', 'N', */ - /* Am, An, A, LDA, work); */ - /* } */ - - /* Binitnorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', chameleon_lapack_const(uplo[u]), 'N', */ - /* M, N, Bref, LDB, work); */ - /* Bchamnorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', chameleon_lapack_const(uplo[u]), 'N', */ - /* M, N, Bcham, LDB, work); */ - - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - Am, An, A, LDA, work); - Binitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - M, N, Bref, LDB, work); - Bchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - M, N, Bcham, LDB, work); - - CORE_ztradd(uplo, trans, M, N, - alpha, A, LDA, - beta, Bref, LDB); - cblas_zaxpy( LDB*N, CBLAS_SADDR(mzone), Bcham, 1, Bref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'M', M, N, Bref, LDB, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Bnorm %e, (alpha A + beta B) norm %e\n", - Rnorm, Anorm, Binitnorm, Bchamnorm); - - result = Rnorm / (max(Anorm, Binitnorm) * eps); - printf("============\n"); - printf("Checking the norm of the difference against reference ZGEADD \n"); - printf("-- || R||_max/(max(||A||_oo,||B||_oo).eps) = %e \n", - result); - - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; + static int run_id = 0; + int hres = 0; + int Am, An; + CHAM_desc_t *descA, *descB; + + /* Read arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? M : N ) ); + int LDB = run_arg_get_int( args, "LDB", M ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zgeadd( M, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + if ( trans != ChamNoTrans ) { + Am = N; + An = M; } else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; + Am = M; + An = N; } - free(work); + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); - return info_solution; -} + /* Fill the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); -/*-------------------------------------------------------------- - * Check the solution - */ - -static int check_ge_solution(cham_trans_t trans, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB) -{ - int info_solution; - double Anorm, Binitnorm, Bchamnorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t mzone; + /* Compute the sum */ + START_TIMING( t ); + hres = CHAMELEON_zgeadd_Tile( trans, alpha, descA, beta, descB ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - double *work = (double *)malloc(max(M, N)* sizeof(double)); - int Am, An; + /* Check the solution */ + if ( check ) { + CHAM_desc_t *descB0 = CHAMELEON_Desc_Copy( descB, NULL ); + CHAMELEON_zplrnt_Tile( descB0, seedB ); - mzone = -1.0; + hres += check_zsum( args, ChamUpperLower, trans, alpha, descA, beta, descB0, descB ); - if (trans == ChamNoTrans) { - Am = M; An = N; - } else { - Am = N; An = M; + CHAMELEON_Desc_Destroy( &descB0 ); } - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - Am, An, A, LDA, work); - Binitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - M, N, Bref, LDB, work); - Bchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - M, N, Bcham, LDB, work); - - CORE_zgeadd(trans, M, N, - alpha, A, LDA, - beta, Bref, LDB); - cblas_zaxpy( LDB*N, CBLAS_SADDR(mzone), Bcham, 1, Bref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'M', M, N, Bref, LDB, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Bnorm %e, (alpha A + beta B) norm %e\n", - Rnorm, Anorm, Binitnorm, Bchamnorm); - - result = Rnorm / (max(Anorm, Binitnorm) * eps); - printf("============\n"); - printf("Checking the norm of the difference against reference ZGEADD \n"); - printf("-- || R||_max/(max(||A||_oo,||B||_oo).eps) = %e \n", - result); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } + run_id++; + return hres; +} - free(work); +testing_t test_zgeadd; +const char *zgeadd_params[] = { "nb", "trans", "m", "n", "lda", "ldb", + "alpha", "beta", "seedA", "seedB", NULL }; +const char *zgeadd_output[] = { NULL }; +const char *zgeadd_outchk[] = { "RETURN", NULL }; - return info_solution; +/** + * @brief Testing registration function + */ +void testing_zgeadd_init( void ) __attribute__( ( constructor ) ); +void +testing_zgeadd_init( void ) +{ + test_zgeadd.name = "zgeadd"; + test_zgeadd.helper = "General matrix-matrix addition"; + test_zgeadd.params = zgeadd_params; + test_zgeadd.output = zgeadd_output; + test_zgeadd.outchk = zgeadd_outchk; + test_zgeadd.params_list = "nb;P;trans;m;n;lda;ldb;alpha;beta;seedA;seedB"; + test_zgeadd.fptr = testing_zgeadd; + test_zgeadd.next = NULL; + + testing_register( &test_zgeadd ); } diff --git a/new-testing/testing_zgelqf.c b/testing/testing_zgelqf.c similarity index 94% rename from new-testing/testing_zgelqf.c rename to testing/testing_zgelqf.c index d3b3eb9c3c555a7e6e490128f0f42412bb77bf2a..8c73a2489c452db88a447471d8d8ef1a75b17de3 100644 --- a/new-testing/testing_zgelqf.c +++ b/testing/testing_zgelqf.c @@ -2,21 +2,21 @@ * * @file testing_zgelqf.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqf testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-10 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -105,7 +105,7 @@ void testing_zgelqf_init( void ) { test_zgelqf.name = "zgelqf"; - test_zgelqf.helper = "zgelqf"; + test_zgelqf.helper = "General LQ factorization"; test_zgelqf.params = zgelqf_params; test_zgelqf.output = zgelqf_output; test_zgelqf.outchk = zgelqf_outchk; diff --git a/new-testing/testing_zgelqf_hqr.c b/testing/testing_zgelqf_hqr.c similarity index 94% rename from new-testing/testing_zgelqf_hqr.c rename to testing/testing_zgelqf_hqr.c index 8ed1cccfb7aca81bdb383e90e08111faa64d615f..14e115298cca1fdadd74fb7266e856b3277e02c5 100644 --- a/new-testing/testing_zgelqf_hqr.c +++ b/testing/testing_zgelqf_hqr.c @@ -2,21 +2,21 @@ * * @file testing_zgelqf_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqf_param testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-10 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -116,7 +116,7 @@ void testing_zgelqf_hqr_init( void ) { test_zgelqf_hqr.name = "zgelqf_hqr"; - test_zgelqf_hqr.helper = "zgelqf_hqr"; + test_zgelqf_hqr.helper = "General LQ factorization with hierachical reduction trees"; test_zgelqf_hqr.params = zgelqf_hqr_params; test_zgelqf_hqr.output = zgelqf_hqr_output; test_zgelqf_hqr.outchk = zgelqf_hqr_outchk; diff --git a/new-testing/testing_zgelqs.c b/testing/testing_zgelqs.c similarity index 95% rename from new-testing/testing_zgelqs.c rename to testing/testing_zgelqs.c index 06eb52c437fcb4cb1e03b69ee99b94887e4e7edb..10777ed62b76b3791f157ae702529039eb9d2c85 100644 --- a/new-testing/testing_zgelqs.c +++ b/testing/testing_zgelqs.c @@ -2,21 +2,21 @@ * * @file testing_zgelqs.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgelqs testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-10 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" #include "control/common.h" @@ -123,7 +123,7 @@ void testing_zgelqs_init( void ) { test_zgelqs.name = "zgelqs"; - test_zgelqs.helper = "zgelqs"; + test_zgelqs.helper = "General LQ solve"; test_zgelqs.params = zgelqs_params; test_zgelqs.output = zgelqs_output; test_zgelqs.outchk = zgelqs_outchk; diff --git a/testing/testing_zgels.c b/testing/testing_zgels.c index 5c5cea65c52a1caad1d3b60a6490ecc6a859a48d..222478fab837d739157b4cdf0a72ddaa39b1ba6b 100644 --- a/testing/testing_zgels.c +++ b/testing/testing_zgels.c @@ -2,510 +2,150 @@ * * @file testing_zgels.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgels testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Bilel Hadri - * @author Hatem Ltaief - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality(int, int, int, CHAMELEON_Complex64_t*, double); -static int check_factorization(int, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, double); -static int check_solution(int, int, int, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, double); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" +#include "../control/common.h" -int testing_zgels(int argc, char **argv) +static cham_fixdbl_t +flops_zgels( cham_trans_t trans, int M, int N, int NRHS ) { - int hres = 0; - int mode = 0; - - if ( argc < 1 ){ - goto usage; - } else { - mode = atoi(argv[0]); - } - - /* Check for number of arguments*/ - if ( ((mode == 0) && (argc != 6)) || - ((mode != 0) && (argc != 7)) ){ - usage: - USAGE("GELS", "MODE M N LDA NRHS LDB [RH]", - " - MODE : 0: flat, 1: tree (RH needed)\n" - " - M : number of rows of the matrix A\n" - " - N : number of columns of the matrix A\n" - " - LDA : leading dimension of the matrix A\n" - " - NRHS : number of RHS\n" - " - LDB : leading dimension of the matrix B\n" - " - RH : Size of each subdomains\n"); - return -1; - } - - int M = atoi(argv[1]); - int N = atoi(argv[2]); - int LDA = max( atoi(argv[3]), M ); - int NRHS = atoi(argv[4]); - int LDB = max( max( atoi(argv[5]), M ), N ); - int rh; - - int K = min(M, N); - double eps; - int info_ortho, info_solution, info_factorization; - int i,j; - int LDAxN = LDA*N; - int LDBxNRHS = LDB*NRHS; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B1 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B2 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAM_desc_t *T; - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2) || (!B1) || (!B2) || (!Q) ) - { - free(A1); free(A2); - free(B1); free(B2); - free(Q); - printf("Out of Memory \n "); - return -2; - } - - if ( mode ) { - rh = atoi(argv[6]); - - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_MODE, ChamTreeHouseholder); - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_SIZE, rh); - } - - CHAMELEON_Alloc_Workspace_zgels(M, N, &T, 1, 1); - eps = LAPACKE_dlamch_work('e'); - - /*---------------------------------------------------------- - * TESTING ZGELS - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - /* CHAMELEON ZGELS */ - CHAMELEON_zgels(ChamNoTrans, M, N, NRHS, A2, LDA, T, B2, LDB); - - /* CHAMELEON ZGELS */ - if (M >= N) - /* Building the economy-size Q */ - CHAMELEON_zungqr(M, N, K, A2, LDA, T, Q, LDA); - else - /* Building the economy-size Q */ - CHAMELEON_zunglq(M, N, K, A2, LDA, T, Q, LDA); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELS ...................... PASSED !\n"); - printf("***************************************************\n"); - } - else { - hres++; - printf("************************************************\n"); - printf(" - TESTING ZGELS ... FAILED !\n"); - printf("************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZGEQRF + ZGEQRS or ZGELQF + ZGELQS - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - for (i = 0; i < M; i++) - for (j = 0; j < N; j++) - A2[LDA*j+i] = A1[LDA*j+i]; - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - for (i = 0; i < M; i++) - for (j = 0; j < NRHS; j++) - B2[LDB*j+i] = B1[LDB*j+i]; - - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZGEQRS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgeqrf(M, N, A2, LDA, T); - CHAMELEON_zungqr(M, N, K, A2, LDA, T, Q, LDA); - CHAMELEON_zgeqrs(M, N, NRHS, A2, LDA, T, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZGEQRS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else{ - hres++; - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZGEQRS ... FAILED !\n"); - printf("***************************************************\n"); - } - } - else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZGELQS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgelqf(M, N, A2, LDA, T); - CHAMELEON_zunglq(M, N, K, A2, LDA, T, Q, LDA); - CHAMELEON_zgelqs(M, N, NRHS, A2, LDA, T, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZGELQS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else { - hres++; - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZGELQS ... FAILED !\n"); - printf("***************************************************\n"); - } - } - - /*---------------------------------------------------------- - * TESTING ZGEQRF + ZORMQR + ZTRSM - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - for (i = 0; i < M; i++) - for (j = 0; j < N; j++) - A2[LDA*j+i] = A1[LDA*j+i]; - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - for (i = 0; i < M; i++) - for (j = 0; j < NRHS; j++) - B2[LDB*j+i] = B1[LDB*j+i]; - - /* CHAMELEON ZGEQRF+ ZUNMQR + ZTRSM */ - memset((void*)Q, 0, LDA*N*sizeof(CHAMELEON_Complex64_t)); - for (i = 0; i < K; i++) - Q[LDA*i+i] = 1.0; - - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZUNMQR + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); + cham_fixdbl_t flops = 0.; + return flops; +} - CHAMELEON_zgeqrf(M, N, A2, LDA, T); - CHAMELEON_zungqr(M, N, K, A2, LDA, T, Q, LDA); - CHAMELEON_zunmqr(ChamLeft, ChamConjTrans, M, NRHS, N, A2, LDA, T, B2, LDB); - CHAMELEON_ztrsm(ChamLeft, ChamUpper, ChamNoTrans, ChamNonUnit, N, NRHS, 1.0, A2, LDA, B2, LDB); +int +testing_zgels( run_arg_list_t *args, int check ) +{ + static int run_id = 0; + int hres = 0; + CHAM_desc_t *descA, *descX, *descT; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int ib = run_arg_get_int( args, "ib", 48 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int maxMN = chameleon_max( M, N ); + int NRHS = run_arg_get_int( args, "NRHS", 1 ); + int LDA = run_arg_get_int( args, "LDA", M ); + int LDB = run_arg_get_int( args, "LDB", maxMN ); + int RH = run_arg_get_int( args, "qra", 4 ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zgels( trans, M, N, NRHS ); + + /* Make sure trans is only Notrans or ConjTrans */ + trans = ( trans == ChamNoTrans ) ? trans : ChamConjTrans; + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + CHAMELEON_Set( CHAMELEON_INNER_BLOCK_SIZE, ib ); + + if ( RH > 0 ) { + CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_MODE, ChamTreeHouseholder ); + CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_SIZE, RH ); } else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZUNMLQ + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - CHAMELEON_zgelqf(M, N, A2, LDA, T); - CHAMELEON_ztrsm(ChamLeft, ChamLower, ChamNoTrans, ChamNonUnit, M, NRHS, 1.0, A2, LDA, B2, LDB); - CHAMELEON_zunglq(M, N, K, A2, LDA, T, Q, LDA); - CHAMELEON_zunmlq(ChamLeft, ChamConjTrans, N, NRHS, M, A2, LDA, T, B2, LDB); - } - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - if (M >= N) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZUNMQR + ZTRSM .... PASSED !\n"); - printf("***************************************************\n"); + CHAMELEON_Set( CHAMELEON_HOUSEHOLDER_MODE, ChamFlatHouseholder ); + } + + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); + CHAMELEON_Alloc_Workspace_zgels( M, N, &descT, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descX, seedB ); + + /* Computes the solution */ + START_TIMING( t ); + hres = CHAMELEON_zgels_Tile( trans, descA, descT, descX ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + if ( check ) { + CHAM_desc_t *descA0, *descB; + CHAM_desc_t *subX, *subB; + + CHAMELEON_Desc_Create( + &descA0, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); + + CHAMELEON_zplrnt_Tile( descA0, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + + if ( trans == ChamNoTrans ) { + subX = chameleon_desc_submatrix( descX, 0, 0, N, NRHS ); + subB = chameleon_desc_submatrix( descB, 0, 0, M, NRHS ); } else { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZTRSM + ZUNMLQ .... PASSED !\n"); - printf("***************************************************\n"); + subX = chameleon_desc_submatrix( descX, 0, 0, M, NRHS ); + subB = chameleon_desc_submatrix( descB, 0, 0, N, NRHS ); } - } - else { - hres++; - if (M >= N) { - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZUNMQR + ZTRSM ... FAILED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZTRSM + ZUNMLQ ... FAILED !\n"); - printf("***************************************************\n"); - } - } + /* Check the factorization and the residual */ + hres = check_zgels( args, trans, descA0, subX, subB ); - free(A1); free(A2); free(B1); free(B2); free(Q); - CHAMELEON_Dealloc_Workspace( &T ); + CHAMELEON_Desc_Destroy( &descA0 ); + CHAMELEON_Desc_Destroy( &descB ); - return hres; -} - -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ - -static int check_orthogonality(int M, int N, int LDQ, CHAMELEON_Complex64_t *Q, double eps) -{ - double alpha, beta; - double normQ; - int info_ortho; - int i; - int minMN = min(M, N); - - double *work = (double *)malloc(minMN*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - /* Build the idendity matrix USE DLASET?*/ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Id, 0, minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - for (i = 0; i < minMN; i++) { - Id[i*minMN+i] = (CHAMELEON_Complex64_t)1.0; - } - - /* Perform Id - Q'Q */ - if (M >= N) { - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, alpha, Q, LDQ, beta, Id, N); - } - else { - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, alpha, Q, LDQ, beta, Id, M); - } - normQ = LAPACKE_zlansy_work( LAPACK_COL_MAJOR, 'i', 'u', minMN, Id, minMN, work ); - - printf("============\n"); - printf("Checking the orthogonality of Q \n"); - printf("||Id-Q'*Q||_oo / (N*eps) = %e \n", normQ/(minMN*eps)); - - if ( isnan(normQ / (minMN * eps)) || isinf(normQ / (minMN * eps)) || (normQ / (minMN * eps) > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; + free( subB ); + free( subX ); } - free(work); free(Id); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descT ); + CHAMELEON_Desc_Destroy( &descX ); - return info_ortho; + run_id++; + return hres; } -/*------------------------------------------------------------ - * Check the factorization QR - */ - -static int check_factorization(int M, int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, CHAMELEON_Complex64_t *Q, double eps ) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha, beta; - int info_factorization; - int i,j; - - CHAMELEON_Complex64_t *Ql = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(max(M,N)*sizeof(double)); - - alpha=1.0; - beta=0.0; - - if (M >= N) { - /* Extract the R */ - CHAMELEON_Complex64_t *R = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)R, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', M, N, A2, LDA, R, N); - - /* Perform Ql=Q*R */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, N, CBLAS_SADDR(alpha), Q, LDA, R, N, CBLAS_SADDR(beta), Ql, M); - free(R); - } - else { - /* Extract the L */ - CHAMELEON_Complex64_t *L = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L, 0, M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', M, N, A2, LDA, L, M); - - /* Perform Ql=LQ */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, M, CBLAS_SADDR(alpha), L, M, Q, LDA, CBLAS_SADDR(beta), Ql, M); - free(L); - } - - /* Compute the Residual */ - for (i = 0; i < M; i++) - for (j = 0 ; j < N; j++) - Residual[j*M+i] = A1[j*LDA+i]-Ql[j*M+i]; - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, N, Residual, M, work ); - Anorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, N, A2, LDA, work ); - - if (M >= N) { - printf("============\n"); - printf("Checking the QR Factorization \n"); - printf("-- ||A-QR||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - else { - printf("============\n"); - printf("Checking the LQ Factorization \n"); - printf("-- ||A-LQ||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - - if (isnan(Rnorm / (Anorm * N *eps)) || isinf(Rnorm / (Anorm * N *eps)) || (Rnorm / (Anorm * N * eps) > 60.0) ) { - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else { - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(work); free(Ql); free(Residual); - - return info_factorization; -} +testing_t test_zgels; +const char *zgels_params[] = { "nb", "ib", "trans", "m", "n", "k", + "lda", "ldb", "qra", "seedA", "seedB", NULL }; +const char *zgels_output[] = { NULL }; +const char *zgels_outchk[] = { "RETURN", NULL }; -/*-------------------------------------------------------------- - * Check the solution +/** + * @brief Testing registration function */ - -static int check_solution(int M, int N, int NRHS, CHAMELEON_Complex64_t *A, int LDA, CHAMELEON_Complex64_t *B, CHAMELEON_Complex64_t *X, int LDB, double eps) +void testing_zgels_init( void ) __attribute__( ( constructor ) ); +void +testing_zgels_init( void ) { - int info_solution; - double Rnorm, Anorm, Xnorm, Bnorm; - CHAMELEON_Complex64_t alpha, beta; - double result; - double *work = (double *)malloc(max(M, N)* sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - Anorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, N, A, LDA, work ); - Bnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', N, NRHS, B, LDB, work ); - Xnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, X, LDB, work ); - - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, NRHS, N, CBLAS_SADDR(alpha), A, LDA, X, LDB, CBLAS_SADDR(beta), B, LDB); - - if (M >= N) { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, M*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, M); - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, Residual, M, work ); - free(Residual); - } - else { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, N*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, N); - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', N, NRHS, Residual, N, work ); - free(Residual); - } - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The solution is CORRECT ! \n"); - info_solution = 0; - } - free(work); - return info_solution; + test_zgels.name = "zgels"; + test_zgels.helper = "Linear least squares with general matrix"; + test_zgels.params = zgels_params; + test_zgels.output = zgels_output; + test_zgels.outchk = zgels_outchk; + test_zgels.params_list = "nb;ib;P;trans;m;n;k;lda;ldb;rh;seedA;seedB"; + test_zgels.fptr = testing_zgels; + test_zgels.next = NULL; + + testing_register( &test_zgels ); } diff --git a/testing/testing_zgels_hqr.c b/testing/testing_zgels_hqr.c index fc5c0e16276672b6c79bbb9b1b25d0f3b4fe37d3..03b04323418e829c2e2545f1263b9fa3a370ee86 100644 --- a/testing/testing_zgels_hqr.c +++ b/testing/testing_zgels_hqr.c @@ -2,507 +2,160 @@ * * @file testing_zgels_hqr.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgels_hqr testing * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Boucherie Raphael + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2017-05-22 + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> -#include <assert.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality(int, int, int, CHAMELEON_Complex64_t*, double); -static int check_factorization(int, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, double); -static int check_solution(int, int, int, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, double); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" +#include "../control/common.h" -int testing_zgels_hqr(int argc, char **argv) +static cham_fixdbl_t +flops_zgels_hqr( cham_trans_t trans, int M, int N, int NRHS ) { - int hres = 0; - - if ( argc < 1 ){ - goto usage; - } + cham_fixdbl_t flops = 0.; + return flops; +} - /* Check for number of arguments*/ - if ( argc != 10 ) { - usage: - USAGE("GELS_HQR", "M N LDA NRHS LDB", - " - M : number of rows of the matrix A\n" - " - N : number of columns of the matrix A\n" - " - LDA : leading dimension of the matrix A\n" - " - NRHS : number of RHS\n" - " - LDB : leading dimension of the matrix B\n" - " - QR_A : Size of TS domain\n" - " - QR_P : Size of high level tree for distributed mode (default: -1)\n" - " - LLVL : tree used for low level reduction insides nodes (default: -1)\n" - " - HLVL : tree used for high level reduction between nodes, only if qr_p > 1(default: -1)\n" - " - DOMINO : Enable/Disable the domino between upper and lower trees (default: -1)\n" - ); - return -1; - } +int +testing_zgels_hqr( run_arg_list_t *args, int check ) +{ + static int run_id = 0; + int hres = 0; + CHAM_desc_t *descA, *descX, *descTS, *descTT; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int ib = run_arg_get_int( args, "ib", 48 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int maxMN = chameleon_max( M, N ); + int NRHS = run_arg_get_int( args, "NRHS", 1 ); + int LDA = run_arg_get_int( args, "LDA", M ); + int LDB = run_arg_get_int( args, "LDB", maxMN ); + int qr_a = run_arg_get_int( args, "qra", -1 ); + int qr_p = run_arg_get_int( args, "qrp", -1 ); + int llvl = run_arg_get_int( args, "llvl", -1 ); + int hlvl = run_arg_get_int( args, "hlvl", -1 ); + int domino = run_arg_get_int( args, "domino", -1 ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zgels_hqr( trans, M, N, NRHS ); - int M = atoi(argv[0]); - int N = atoi(argv[1]); - int LDA = chameleon_max( atoi(argv[2]), M ); - int NRHS = atoi(argv[3]); - int LDB = chameleon_max( chameleon_max( atoi(argv[4]), M ), N ); - int qr_a = atoi(argv[5]); - int qr_p = atoi(argv[6]); - int llvl = atoi(argv[7]); - int hlvl = atoi(argv[8]); - int domino = atoi(argv[9]); libhqr_tree_t qrtree; libhqr_matrix_t matrix; - int K = min(M, N); - double eps; - int info_ortho, info_solution, info_factorization; - int LDAxN = LDA*N; - int LDBxNRHS = LDB*NRHS; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B1 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B2 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAM_desc_t *TS; - CHAM_desc_t *TT = NULL; - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2) || (!B1) || (!B2) || (!Q) ) - { - free(A1); free(A2); - free(B1); free(B2); - free(Q); - printf("Out of Memory \n "); - return -2; - } - - CHAMELEON_Alloc_Workspace_zgels(M, N, &TS, 1, 1); - CHAMELEON_Alloc_Workspace_zgels(M, N, &TT, 1, 1); - - eps = LAPACKE_dlamch_work( 'e' ); - - /*---------------------------------------------------------- - * TESTING ZGEQRF_PARAM - */ - - /* Initialize matrix */ - matrix.mt = TS->mt; - matrix.nt = TS->nt; - matrix.nodes = 1; - matrix.p = 1; - - libhqr_init_hqr( &qrtree, - ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, - &matrix, llvl, hlvl, qr_a, qr_p, domino, 0); - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - /* CHAMELEON ZGELS */ - CHAMELEON_zgels_param(&qrtree, ChamNoTrans, M, N, NRHS, A2, LDA, TS, TT, B2, LDB); - - /* CHAMELEON ZGELS */ - if (M >= N) - /* Building the economy-size Q */ - CHAMELEON_zungqr_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - else - /* Building the economy-size Q */ - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELS_HQR ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELS_HQR ............... PASSED !\n"); - printf("***************************************************\n"); - } - else { - hres++; - printf("************************************************\n"); - printf(" - TESTING ZGELS_HQR ... FAILED !\n"); - printf("************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZGEQRF + ZGEQRS or ZGELQF + ZGELQS - */ - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZGEQRS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgeqrf_param( &qrtree, M, N, A2, LDA, TS, TT ); - CHAMELEON_zungqr_param( &qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zgeqrs_param( &qrtree, M, N, NRHS, A2, LDA, TS,TT, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZGEQRS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else{ - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZGEQRS ... FAILED !\n"); - printf("***************************************************\n"); - } - } - else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZGELQS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgelqf_param(&qrtree, M, N, A2, LDA, TS, TT); - //CHAMELEON_zgelqf(M, N, A2, LDA, TS); - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - //CHAMELEON_zunglq(M, N, K, A2, LDA, TS, Q, LDA); - CHAMELEON_zgelqs_param(&qrtree, M, N, NRHS, A2, LDA, TS, TT, B2, LDB); - //CHAMELEON_zgelqs(M, N, NRHS, A2, LDA, TS, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZGELQS ............ PASSED !\n"); - printf("***************************************************\n"); + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + CHAMELEON_Set( CHAMELEON_INNER_BLOCK_SIZE, ib ); + + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); + CHAMELEON_Alloc_Workspace_zgels( M, N, &descTS, P, Q ); + CHAMELEON_Alloc_Workspace_zgels( M, N, &descTT, P, Q ); + + /* Initialize matrix tree */ + matrix.mt = descTS->mt; + matrix.nt = descTS->nt; + matrix.nodes = P * Q; + matrix.p = P; + + libhqr_init_hqr( + &qrtree, ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, &matrix, llvl, hlvl, qr_a, qr_p, domino, 0 ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descX, seedB ); + + /* Computes the solution */ + START_TIMING( t ); + hres = CHAMELEON_zgels_param_Tile( &qrtree, trans, descA, descTS, descTT, descX ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + if ( check ) { + CHAM_desc_t *descA0, *descB; + CHAM_desc_t *subX, *subB; + + CHAMELEON_Desc_Create( + &descA0, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, maxMN, NRHS, P, Q ); + + CHAMELEON_zplrnt_Tile( descA0, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + + if ( trans == ChamNoTrans ) { + subX = chameleon_desc_submatrix( descX, 0, 0, N, NRHS ); + subB = chameleon_desc_submatrix( descB, 0, 0, M, NRHS ); } else { - hres++; - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZGELQS ... FAILED !\n"); - printf("***************************************************\n"); + subX = chameleon_desc_submatrix( descX, 0, 0, M, NRHS ); + subB = chameleon_desc_submatrix( descB, 0, 0, N, NRHS ); } - } - - /*---------------------------------------------------------- - * TESTING ZGEQRF + ZORMQR + ZTRSM - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); + /* Check the factorization and the residual */ + hres = check_zgels( args, trans, descA0, subX, subB ); - /* Initialize Q */ - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', LDA, N, 0., 1., Q, LDA ); + CHAMELEON_Desc_Destroy( &descA0 ); + CHAMELEON_Desc_Destroy( &descB ); - /* CHAMELEON ZGEQRF+ ZUNMQR + ZTRSM */ - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZUNMQR + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - CHAMELEON_zgeqrf_param( &qrtree, M, N, A2, LDA, TS, TT ); - CHAMELEON_zungqr_param( &qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zunmqr_param( &qrtree, ChamLeft, ChamConjTrans, M, NRHS, N, A2, LDA, TS, TT, B2, LDB); - CHAMELEON_ztrsm(ChamLeft, ChamUpper, ChamNoTrans, ChamNonUnit, N, NRHS, 1.0, A2, LDA, B2, LDB); - } - else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZUNMLQ + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - CHAMELEON_zgelqf_param(&qrtree, M, N, A2, LDA, TS, TT); - CHAMELEON_ztrsm(ChamLeft, ChamLower, ChamNoTrans, ChamNonUnit, M, NRHS, 1.0, A2, LDA, B2, LDB); - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zunmlq_param(&qrtree, ChamLeft, ChamConjTrans, N, NRHS, M, A2, LDA, TS, TT, B2, LDB); - } - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - if (M >= N) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZUNMQR + ZTRSM .... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZTRSM + ZUNMLQ .... PASSED !\n"); - printf("***************************************************\n"); - } - } - else { - hres++; - - if (M >= N) { - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZUNMQR + ZTRSM ... FAILED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZTRSM + ZUNMLQ ... FAILED !\n"); - printf("***************************************************\n"); - } + free( subB ); + free( subX ); } + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descTS ); + CHAMELEON_Desc_Destroy( &descTT ); + CHAMELEON_Desc_Destroy( &descX ); libhqr_finalize( &qrtree ); - free(A1); free(A2); free(B1); free(B2); free(Q); - CHAMELEON_Dealloc_Workspace( &TS ); - CHAMELEON_Dealloc_Workspace( &TT ); - + run_id++; return hres; } -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ - -static int check_orthogonality(int M, int N, int LDQ, CHAMELEON_Complex64_t *Q, double eps) -{ - double alpha, beta; - double normQ; - int info_ortho; - int minMN = min(M, N); - - double *work = (double *)malloc(minMN*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - /* Build the idendity matrix USE DLASET?*/ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', minMN, minMN, 0., 1., Id, minMN ); - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, alpha, Q, LDQ, beta, Id, N); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, alpha, Q, LDQ, beta, Id, M); - - normQ = LAPACKE_zlansy( LAPACK_COL_MAJOR, 'I', 'U', minMN, Id, minMN ); - - printf("============\n"); - printf("Checking the orthogonality of Q \n"); - printf("||Id-Q'*Q||_oo / (N*eps) = %e \n", normQ/(minMN*eps)); - - if ( isnan(normQ / (minMN * eps)) || isinf(normQ / (minMN * eps)) || (normQ / (minMN * eps) > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; - } - - free(work); free(Id); - - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the factorization QR - */ - -static int check_factorization(int M, int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, CHAMELEON_Complex64_t *Q, double eps ) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha, beta; - int info_factorization; - int i,j; - - CHAMELEON_Complex64_t *Ql = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(max(M,N)*sizeof(double)); - - alpha=1.0; - beta=0.0; - - if (M >= N) { - /* Extract the R */ - CHAMELEON_Complex64_t *R = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)R, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', M, N, A2, LDA, R, N); - - /* Perform Ql=Q*R */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, N, CBLAS_SADDR(alpha), Q, LDA, R, N, CBLAS_SADDR(beta), Ql, M); - free(R); - } - else { - /* Extract the L */ - CHAMELEON_Complex64_t *L = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L, 0, M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', M, N, A2, LDA, L, M); - - /* Perform Ql=LQ */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, M, CBLAS_SADDR(alpha), L, M, Q, LDA, CBLAS_SADDR(beta), Ql, M); - free(L); - } - - /* Compute the Residual */ - for (i = 0; i < M; i++) - for (j = 0 ; j < N; j++) - Residual[j*M+i] = A1[j*LDA+i]-Ql[j*M+i]; - - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, Residual, M ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, A2, LDA ); - - if (M >= N) { - printf("============\n"); - printf("Checking the QR Factorization \n"); - printf("-- ||A-QR||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - else { - printf("============\n"); - printf("Checking the LQ Factorization \n"); - printf("-- ||A-LQ||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - - if (isnan(Rnorm / (Anorm * N *eps)) || isinf(Rnorm / (Anorm * N *eps)) || (Rnorm / (Anorm * N * eps) > 60.0) ) { - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else { - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(work); free(Ql); free(Residual); - - return info_factorization; -} +testing_t test_zgels_hqr; +const char *zgels_hqr_params[] = { "nb", "ib", "trans", "m", "n", "k", + "lda", "ldb", "qra", "qra", "qrp", "llvl", + "hlvl", "domino", "seedA", "seedB", NULL }; +const char *zgels_hqr_output[] = { NULL }; +const char *zgels_hqr_outchk[] = { "RETURN", NULL }; -/*-------------------------------------------------------------- - * Check the solution +/** + * @brief Testing registration function */ - -static int check_solution(int M, int N, int NRHS, CHAMELEON_Complex64_t *A, int LDA, CHAMELEON_Complex64_t *B, CHAMELEON_Complex64_t *X, int LDB, double eps) +void testing_zgels_hqr_init( void ) __attribute__( ( constructor ) ); +void +testing_zgels_hqr_init( void ) { - int info_solution; - double Rnorm, Anorm, Xnorm, Bnorm; - CHAMELEON_Complex64_t alpha, beta; - double result; - double *work = (double *)malloc(max(M, N)* sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, A, LDA ); - Bnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', N, NRHS, B, LDB ); - Xnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, NRHS, X, LDB ); - - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, NRHS, N, CBLAS_SADDR(alpha), A, LDA, X, LDB, CBLAS_SADDR(beta), B, LDB); - - if (M >= N) { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, M*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, M); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, NRHS, Residual, M ); - free(Residual); - } - else { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, N*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, N); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', N, NRHS, Residual, N ); - free(Residual); - } - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The solution is CORRECT ! \n"); - info_solution = 0; - } - free(work); - return info_solution; + test_zgels_hqr.name = "zgels_hqr"; + test_zgels_hqr.helper = "Linear least squares with general matrix using hierarchical reduction trees"; + test_zgels_hqr.params = zgels_hqr_params; + test_zgels_hqr.output = zgels_hqr_output; + test_zgels_hqr.outchk = zgels_hqr_outchk; + test_zgels_hqr.params_list = + "nb;ib;P;trans;m;n;k;lda;ldb;rh;qra;qrp;llvl;hlvl;domino;seedA;seedB"; + test_zgels_hqr.fptr = testing_zgels_hqr; + test_zgels_hqr.next = NULL; + + testing_register( &test_zgels_hqr ); } diff --git a/testing/testing_zgels_systolic.c b/testing/testing_zgels_systolic.c deleted file mode 100644 index 7687b7b36c6bb9832f90fbd3bc912109d488ff5e..0000000000000000000000000000000000000000 --- a/testing/testing_zgels_systolic.c +++ /dev/null @@ -1,507 +0,0 @@ -/** - * - * @file testing_zgels_systolic.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgels_systolic testing - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Boucherie Raphael - * @author Lucas Barros de Assis - * @date 2017-05-22 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> -#include <assert.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality(int, int, int, CHAMELEON_Complex64_t*, double); -static int check_factorization(int, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, double); -static int check_solution(int, int, int, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, CHAMELEON_Complex64_t*, int, double); - -int testing_zgels_systolic(int argc, char **argv) -{ - int hres = 0; - - if ( argc < 1 ){ - goto usage; - } - - /* Check for number of arguments*/ - if ( argc != 7 ) { - usage: - USAGE("GELS_SYSTOLIC", "M N LDA NRHS LDB", - " - M : number of rows of the matrix A\n" - " - N : number of columns of the matrix A\n" - " - LDA : leading dimension of the matrix A\n" - " - NRHS : number of RHS\n" - " - LDB : leading dimension of the matrix B\n" - " - P : size of the highest level reduction tree\n" - " - Q : size of the middle reduction trees\n" - ); - return -1; - } - - int M = atoi(argv[0]); - int N = atoi(argv[1]); - int LDA = max( atoi(argv[2]), M ); - int NRHS = atoi(argv[3]); - int LDB = max( max( atoi(argv[4]), M ), N ); - int p = atoi(argv[5]); - int q = atoi(argv[6]); - libhqr_tree_t qrtree; - libhqr_matrix_t matrix; - - int K = min(M, N); - double eps; - int info_ortho, info_solution, info_factorization; - int LDAxN = LDA*N; - int LDBxNRHS = LDB*NRHS; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B1 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B2 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAM_desc_t *TS; - CHAM_desc_t *TT = NULL; - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2) || (!B1) || (!B2) || (!Q) ) - { - free(A1); free(A2); - free(B1); free(B2); - free(Q); - printf("Out of Memory \n "); - return -2; - } - - CHAMELEON_Alloc_Workspace_zgels(M, N, &TS, 1, 1); - CHAMELEON_Alloc_Workspace_zgels(M, N, &TT, 1, 1); - - eps = LAPACKE_dlamch_work( 'e' ); - - /*---------------------------------------------------------- - * TESTING ZGEQRF_PARAM - */ - - /* Initialize matrix */ - matrix.mt = TS->mt; - matrix.nt = TS->nt; - matrix.nodes = 1; - matrix.p = 1; - - libhqr_init_sys( &qrtree, - ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, - &matrix, p, q ); - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - /* CHAMELEON ZGELS */ - CHAMELEON_zgels_param(&qrtree, ChamNoTrans, M, N, NRHS, A2, LDA, TS, TT, B2, LDB); - //CHAMELEON_zgels(ChamNoTrans, M, N, NRHS, A2, LDA, TS, B2, LDB); - - /* CHAMELEON ZGELS */ - if (M >= N) - /* Building the economy-size Q */ - CHAMELEON_zungqr_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - else - /* Building the economy-size Q */ - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - //CHAMELEON_zunglq(M, N, K, A2, LDA, TS, Q, LDA); - - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELS_SYSTOLIC ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELS_SYSTOLIC ............... PASSED !\n"); - printf("***************************************************\n"); - } - else { - hres++; - printf("************************************************\n"); - printf(" - TESTING ZGELS_SYSTOLIC ... FAILED !\n"); - printf("************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZGEQRF + ZGEQRS or ZGELQF + ZGELQS - */ - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZGEQRS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgeqrf_param( &qrtree, M, N, A2, LDA, TS, TT ); - CHAMELEON_zungqr_param( &qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zgeqrs_param( &qrtree, M, N, NRHS, A2, LDA, TS,TT, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)&(info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZGEQRS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else{ - hres++; - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZGEQRS ... FAILED !\n"); - printf("***************************************************\n"); - } - } - else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZGELQS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Cham routines */ - CHAMELEON_zgelqf_param(&qrtree, M, N, A2, LDA, TS, TT); - //CHAMELEON_zunglq(M, N, K, A2, LDA, TS, Q, LDA); - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zgelqs_param(&qrtree, M, N, NRHS, A2, LDA, TS, TT, B2, LDB); - //CHAMELEON_zgelqs(M, N, NRHS, A2, LDA, TS, B2, LDB); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZGELQS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else { - hres++; - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZGELQS ... FAILED !\n"); - printf("***************************************************\n"); - } - } - - /*---------------------------------------------------------- - * TESTING ZGEQRF + ZORMQR + ZTRSM - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - memset(B2, 0, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, B1, LDB, B2, LDB ); - - /* Initialize Q */ - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', LDA, N, 0., 1., Q, LDA ); - - /* CHAMELEON ZGEQRF+ ZUNMQR + ZTRSM */ - if (M >= N) { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEQRF + ZUNMQR + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - CHAMELEON_zgeqrf_param( &qrtree, M, N, A2, LDA, TS, TT ); - CHAMELEON_zungqr_param( &qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - CHAMELEON_zunmqr_param( &qrtree, ChamLeft, ChamConjTrans, M, NRHS, N, A2, LDA, TS, TT, B2, LDB); - CHAMELEON_ztrsm(ChamLeft, ChamUpper, ChamNoTrans, ChamNonUnit, N, NRHS, 1.0, A2, LDA, B2, LDB); - } - else { - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELQF + ZUNMLQ + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - CHAMELEON_zgelqf_param(&qrtree, M, N, A2, LDA, TS, TT); - CHAMELEON_ztrsm(ChamLeft, ChamLower, ChamNoTrans, ChamNonUnit, M, NRHS, 1.0, A2, LDA, B2, LDB); - CHAMELEON_zunglq_param(&qrtree, M, N, K, A2, LDA, TS, TT, Q, LDA); - //CHAMELEON_zunglq(M, N, K, A2, LDA, TS, Q, LDA); - CHAMELEON_zunmlq_param(&qrtree, ChamLeft, ChamConjTrans, N, NRHS, M, A2, LDA, TS, TT, B2, LDB); - //CHAMELEON_zunmlq(ChamLeft, ChamConjTrans, N, NRHS, M, A2, LDA, TS, B2, LDB); - } - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality(M, N, LDA, Q, eps); - info_factorization = check_factorization(M, N, A1, A2, LDA, Q, eps); - info_solution = check_solution(M, N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) & (info_factorization == 0) & (info_ortho == 0) ) { - if (M >= N) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEQRF + ZUNMQR + ZTRSM .... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELQF + ZTRSM + ZUNMLQ .... PASSED !\n"); - printf("***************************************************\n"); - } - } - else { - hres++; - - if (M >= N) { - printf("***************************************************\n"); - printf(" - TESTING ZGEQRF + ZUNMQR + ZTRSM ... FAILED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" - TESTING ZGELQF + ZTRSM + ZUNMLQ ... FAILED !\n"); - printf("***************************************************\n"); - } - } - - libhqr_finalize( &qrtree ); - - free(A1); free(A2); free(B1); free(B2); free(Q); - CHAMELEON_Dealloc_Workspace( &TS ); - CHAMELEON_Dealloc_Workspace( &TT ); - - return hres; -} - -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ - -static int check_orthogonality(int M, int N, int LDQ, CHAMELEON_Complex64_t *Q, double eps) -{ - double alpha, beta; - double normQ; - int info_ortho; - int minMN = min(M, N); - - double *work = (double *)malloc(minMN*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - /* Build the idendity matrix USE DLASET?*/ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', minMN, minMN, 0., 1., Id, minMN ); - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, alpha, Q, LDQ, beta, Id, N); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, alpha, Q, LDQ, beta, Id, M); - - normQ = LAPACKE_zlansy( LAPACK_COL_MAJOR, 'I', 'U', minMN, Id, minMN ); - - printf("============\n"); - printf("Checking the orthogonality of Q \n"); - printf("||Id-Q'*Q||_oo / (N*eps) = %e \n", normQ/(minMN*eps)); - - if ( isnan(normQ / (minMN * eps)) || isinf(normQ / (minMN * eps)) || (normQ / (minMN * eps) > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; - } - - free(work); free(Id); - - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the factorization QR - */ - -static int check_factorization(int M, int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, CHAMELEON_Complex64_t *Q, double eps ) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha, beta; - int info_factorization; - int i,j; - - CHAMELEON_Complex64_t *Ql = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(max(M,N)*sizeof(double)); - - alpha=1.0; - beta=0.0; - - if (M >= N) { - /* Extract the R */ - CHAMELEON_Complex64_t *R = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)R, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', M, N, A2, LDA, R, N); - - /* Perform Ql=Q*R */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, N, CBLAS_SADDR(alpha), Q, LDA, R, N, CBLAS_SADDR(beta), Ql, M); - free(R); - } - else { - /* Extract the L */ - CHAMELEON_Complex64_t *L = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L, 0, M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', M, N, A2, LDA, L, M); - - /* Perform Ql=LQ */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, M, CBLAS_SADDR(alpha), L, M, Q, LDA, CBLAS_SADDR(beta), Ql, M); - free(L); - } - - /* Compute the Residual */ - for (i = 0; i < M; i++) - for (j = 0 ; j < N; j++) - Residual[j*M+i] = A1[j*LDA+i]-Ql[j*M+i]; - - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, Residual, M ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, A2, LDA ); - - if (M >= N) { - printf("============\n"); - printf("Checking the QR Factorization \n"); - printf("-- ||A-QR||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - else { - printf("============\n"); - printf("Checking the LQ Factorization \n"); - printf("-- ||A-LQ||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - - if (isnan(Rnorm / (Anorm * N *eps)) || isinf(Rnorm / (Anorm * N *eps)) || (Rnorm / (Anorm * N * eps) > 60.0) ) { - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else { - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(work); free(Ql); free(Residual); - - return info_factorization; -} - -/*-------------------------------------------------------------- - * Check the solution - */ - -static int check_solution(int M, int N, int NRHS, CHAMELEON_Complex64_t *A, int LDA, CHAMELEON_Complex64_t *B, CHAMELEON_Complex64_t *X, int LDB, double eps) -{ - int info_solution; - double Rnorm, Anorm, Xnorm, Bnorm; - CHAMELEON_Complex64_t alpha, beta; - double result; - double *work = (double *)malloc(max(M, N)* sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, N, A, LDA ); - Bnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', N, NRHS, B, LDB ); - Xnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, NRHS, X, LDB ); - - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, NRHS, N, CBLAS_SADDR(alpha), A, LDA, X, LDB, CBLAS_SADDR(beta), B, LDB); - - if (M >= N) { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, M*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, M); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', M, NRHS, Residual, M ); - free(Residual); - } - else { - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*NRHS*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Residual, 0, N*NRHS*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasConjTrans, CblasNoTrans, N, NRHS, M, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Residual, N); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'I', N, NRHS, Residual, N ); - free(Residual); - } - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The solution is CORRECT ! \n"); - info_solution = 0; - } - free(work); - return info_solution; -} diff --git a/testing/testing_zgemm.c b/testing/testing_zgemm.c index f6c2d151b45d797997e5c49edd5126af15cecdde..06f825df83e41da1f36529e8d71e3e7c8a72027d 100644 --- a/testing/testing_zgemm.c +++ b/testing/testing_zgemm.c @@ -2,227 +2,136 @@ * * @file testing_zgemm.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgemm testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" -#if defined(CHAMELEON_USE_MPI) -#include <mpi.h> -#endif - -static int check_solution(cham_trans_t transA, cham_trans_t transB, int M, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); - -int testing_zgemm(int argc, char **argv) +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" + +int +testing_zgemm( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc < 8) { - USAGE("GEMM", "alpha beta M N K LDA LDB LDC", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - M : number of rows of matrices A and C\n" - " - N : number of columns of matrices B and C\n" - " - K : number of columns of matrix A / number of rows of matrix B\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am, An, Bm, Bn; + int hres = 0; + CHAM_desc_t *descA, *descB, *descC, *descCinit; + + /* Read arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t transA = run_arg_get_trans( args, "transA", ChamNoTrans ); + cham_trans_t transB = run_arg_get_trans( args, "transB", ChamNoTrans ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( transA == ChamNoTrans ) ? M : K ) ); + int LDB = run_arg_get_int( args, "LDB", ( ( transB == ChamNoTrans ) ? K : N ) ); + int LDC = run_arg_get_int( args, "LDC", M ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zgemm( M, N, K ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculate the dimensions according to the transposition */ + if ( transA == ChamNoTrans ) { + Am = M; + An = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int M = atoi(argv[2]); - int N = atoi(argv[3]); - int K = atoi(argv[4]); - int LDA = atoi(argv[5]); - int LDB = atoi(argv[6]); - int LDC = atoi(argv[7]); - - double eps; - int info_solution; - int i, j, ta, tb; - int LDAxK = LDA*max(M,K); - int LDBxN = LDB*max(K,N); - int LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!C) || (!Cinit) || (!Cfinal) ) - { - free(A); free(B); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = K; + An = M; } - - eps = LAPACKE_dlamch_work('e'); - - if (CHAMELEON_Comm_rank() == 0){ - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGEMM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); + if ( transB == ChamNoTrans ) { + Bm = K; + Bn = N; + } + else { + Bm = N; + Bn = K; } - /*---------------------------------------------------------- - * TESTING ZGEMM - */ - - /* Initialize A, B, C */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxK, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - LAPACKE_zlarnv_work(IONE, ISEED, LDCxN, C); - -#if defined(PRECISION_z) || defined(PRECISION_c) - for (ta=0; ta<3; ta++) { - for (tb=0; tb<3; tb++) { -#else - for (ta=0; ta<2; ta++) { - for (tb=0; tb<2; tb++) { -#endif - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cinit[LDC*j+i] = C[LDC*j+i]; - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cfinal[LDC*j+i] = C[LDC*j+i]; - - /* CHAMELEON ZGEMM */ - CHAMELEON_zgemm(trans[ta], trans[tb], M, N, K, alpha, A, LDA, B, LDB, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(trans[ta], trans[tb], M, N, K, - alpha, A, LDA, B, LDB, beta, Cinit, Cfinal, LDC); - if (CHAMELEON_Comm_rank() == 0){ - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGEMM (%s, %s) ............... PASSED !\n", transstr[ta], transstr[tb]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZGEMM (%s, %s) ... FAILED !\n", transstr[ta], transstr[tb]); hres++; - printf("************************************************\n"); - } - } - } + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + + /* Fill the matrices with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + CHAMELEON_zplrnt_Tile( descC, seedC ); + + /* Calculate the product */ + START_TIMING( t ); + hres = CHAMELEON_zgemm_Tile( transA, transB, alpha, descA, descB, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Check the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + CHAMELEON_zplrnt_Tile( descCinit, seedC ); + + hres += check_zgemm( args, transA, transB, alpha, descA, descB, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } -#ifdef _UNUSED_ - }} -#endif - free(A); free(B); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + CHAMELEON_Desc_Destroy( &descC ); + + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zgemm; +const char *zgemm_params[] = { "nb", "transA", "transB", "m", "n", "k", "lda", "ldb", + "ldc", "alpha", "beta", "seedA", "seedB", "seedC", NULL }; +const char *zgemm_output[] = { NULL }; +const char *zgemm_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_trans_t transA, cham_trans_t transB, int M, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zgemm_init( void ) __attribute__( ( constructor ) ); +void +testing_zgemm_init( void ) { - int info_solution; - double Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t beta_const; - - double *work = (double *)malloc(max(K,max(M, N))* sizeof(double)); - int Am, An, Bm, Bn; - - beta_const = -1.0; - - if (transA == ChamNoTrans) { - Am = M; An = K; - } else { - Am = K; An = M; - } - if (transB == ChamNoTrans) { - Bm = K; Bn = N; - } else { - Bm = N; Bn = K; - } - - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', Am, An, A, LDA, work); - Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', Bm, Bn, B, LDB, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work); - - cblas_zgemm(CblasColMajor, (CBLAS_TRANSPOSE)transA, (CBLAS_TRANSPOSE)transB, M, N, K, - CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - cblas_zaxpy(LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - if (CHAMELEON_Comm_rank() == 0) - printf("Rnorm %e, Anorm %e, Bnorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n", - Rnorm, Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm); - - result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps); - if (CHAMELEON_Comm_rank() == 0){ - printf("============\n"); - printf("Checking the norm of the difference against reference ZGEMM \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||B||_oo+||C||_oo).N.eps) = %e \n", - result); - } - - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - if (CHAMELEON_Comm_rank() == 0) - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - //printf("CHAMELEON_Comm_rank() : %d\n",CHAMELEON_Comm_rank()); - if (CHAMELEON_Comm_rank() == 0) - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; + test_zgemm.name = "zgemm"; + test_zgemm.helper = "General matrix-matrix multiply"; + test_zgemm.params = zgemm_params; + test_zgemm.output = zgemm_output; + test_zgemm.outchk = zgemm_outchk; + test_zgemm.params_list = "nb;P;transA;transB;m;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC"; + test_zgemm.fptr = testing_zgemm; + test_zgemm.next = NULL; + + testing_register( &test_zgemm ); } diff --git a/new-testing/testing_zgeqrf.c b/testing/testing_zgeqrf.c similarity index 94% rename from new-testing/testing_zgeqrf.c rename to testing/testing_zgeqrf.c index ad08ca8f7ad64d2c7536c7a552d6df91db540431..321de31695bd97ce94eab239cce9fef3eb9eeb34 100644 --- a/new-testing/testing_zgeqrf.c +++ b/testing/testing_zgeqrf.c @@ -2,21 +2,21 @@ * * @file testing_zgeqrf.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrf testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -105,7 +105,7 @@ void testing_zgeqrf_init( void ) { test_zgeqrf.name = "zgeqrf"; - test_zgeqrf.helper = "zgeqrf"; + test_zgeqrf.helper = "General QR factorization"; test_zgeqrf.params = zgeqrf_params; test_zgeqrf.output = zgeqrf_output; test_zgeqrf.outchk = zgeqrf_outchk; diff --git a/new-testing/testing_zgeqrf_hqr.c b/testing/testing_zgeqrf_hqr.c similarity index 94% rename from new-testing/testing_zgeqrf_hqr.c rename to testing/testing_zgeqrf_hqr.c index a244facc44666bfa6976bcdbb35f62c22f914777..77c60a42b2d77a39aa4e21dd6cb26d427cda1087 100644 --- a/new-testing/testing_zgeqrf_hqr.c +++ b/testing/testing_zgeqrf_hqr.c @@ -2,21 +2,21 @@ * * @file testing_zgeqrf_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrf_hqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -116,7 +116,7 @@ void testing_zgeqrf_hqr_init( void ) { test_zgeqrf_hqr.name = "zgeqrf_hqr"; - test_zgeqrf_hqr.helper = "zgeqrf_hqr"; + test_zgeqrf_hqr.helper = "General QR factorization with hierachical reduction trees"; test_zgeqrf_hqr.params = zgeqrf_hqr_params; test_zgeqrf_hqr.output = zgeqrf_hqr_output; test_zgeqrf_hqr.outchk = zgeqrf_hqr_outchk; diff --git a/testing/testing_zgeqrf_qdwh.c b/testing/testing_zgeqrf_qdwh.c deleted file mode 100644 index f6b93510f89b4a967e23d5e6c6e32a872e8d6fcb..0000000000000000000000000000000000000000 --- a/testing/testing_zgeqrf_qdwh.c +++ /dev/null @@ -1,250 +0,0 @@ -/** - * - * @file testing_zgeqrf_qdwh.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgeqrf_qdwh testing - * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Bilel Hadri - * @author Hatem Ltaief - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2017-01-12 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include <coreblas/coreblas_z.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality(int, int, const CHAMELEON_Complex64_t*, int, double); -static int check_factorization(int, int, const CHAMELEON_Complex64_t*, int, const CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, int, double); - -int testing_zgeqrf_qdwh(int argc, char **argv) -{ - int hres = 0; - - if ( argc != 2 ) { - USAGE("GEQRF_QDWH", "optid M", - " - optid: Take into account the fact that A2 is Id or not\n" - " - M : number of rows of the matrix A1 and A2\n"); - return -1; - } - - int optid = atoi(argv[0]) ? 1: 0; - int M = atoi(argv[1]); - int MxM = M * M; - int LDA = 2*M; - double eps; - int info_ortho, info_factorization; - - /** - * Compute A = QR with - * - * A = [ A1 ] and Q = [ Q1 ] - * [ A2 ] = [ Q2 ] - * - * and where A1 is the same size as A2 - * - */ - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q1 = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q2 = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(2*M*M*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Q; - CHAM_desc_t *T1, *T2; - - /* Check if unable to allocate memory */ - if ( (!A) || (!A1) || (!A2) || (!Q1) || (!Q2) ){ - free(A); free(A1); free(A2); - free(Q1); free(Q2); - printf("Out of Memory \n "); - return -2; - } - - CHAMELEON_Alloc_Workspace_zgels(M, M, &T1, 1, 1); - CHAMELEON_Alloc_Workspace_zgels(M, M, &T2, 1, 1); - - eps = LAPACKE_dlamch('e'); - - /* Initialize A1, A2, and A */ - LAPACKE_zlarnv_work(IONE, ISEED, MxM, A1); - LAPACKE_zlaset_work( LAPACK_COL_MAJOR, 'A', M, M, 0., 1., A2, M ); - - LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A', M, M, A1, M, A, LDA ); - LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A', M, M, A2, M, A + M, LDA ); - - /* Factorize A */ - CHAMELEON_zgeqrf( M, M, A1, M, T1 ); - CHAMELEON_ztpqrt( M, M, optid ? M : 0, - A1, M, - A2, M, T2 ); - - /* Generate the Q */ - CHAMELEON_ztpgqrt( M, M, M, (optid) ? M : 0, - A1, M, T1, A2, M, T2, Q1, M, Q2, M ); - - /* Copy Q in a single matrix */ - Q = (CHAMELEON_Complex64_t *)malloc(2*M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A', M, M, Q1, M, Q, LDA ); - free(Q1); - LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A', M, M, Q2, M, Q + M, LDA ); - free(Q2); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGELS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, M); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the orthogonality, factorization and the solution */ - info_ortho = check_orthogonality( 2*M, M, Q, LDA, eps ); - info_factorization = check_factorization( 2*M, M, A, LDA, A1, M, Q, LDA, eps ); - - if ((info_factorization == 0) & (info_ortho == 0)) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGELS ...................... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZGELS ... FAILED !\n"); hres++; - printf("************************************************\n"); - } - - free(A); free(A1); free(A2); free(Q); - CHAMELEON_Dealloc_Workspace( &T1 ); - CHAMELEON_Dealloc_Workspace( &T2 ); - - return hres; -} - -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ - -static int -check_orthogonality( int M, int N, - const CHAMELEON_Complex64_t *Q, int LDQ, - double eps ) -{ - CHAMELEON_Complex64_t *Id; - double alpha, beta; - double normQ; - int info_ortho; - int minMN = min(M, N); - - double *work = (double *)malloc(minMN*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - /* Build the idendity matrix */ - Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', minMN, minMN, 0., 1., Id, minMN ); - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, beta, Q, LDQ, alpha, Id, N); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, beta, Q, LDQ, alpha, Id, M); - - normQ = LAPACKE_zlansy_work( LAPACK_COL_MAJOR, 'I', 'U', minMN, Id, minMN, work ); - - printf("============\n"); - printf("Checking the orthogonality of Q \n"); - printf("||Id-Q'*Q||_oo / (N*eps) = %e \n", normQ/(minMN*eps)); - - if ( isnan(normQ / (minMN * eps)) || isinf(normQ / (minMN * eps)) || (normQ / (minMN * eps) > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; - } - - free(work); free(Id); - - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the factorization QR - */ - -static int -check_factorization(int M, int N, - const CHAMELEON_Complex64_t *A, int LDA, - const CHAMELEON_Complex64_t *R, int LDR, - CHAMELEON_Complex64_t *Q, int LDQ, - double eps ) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha; - int info_factorization; - double *work = (double *)malloc(max(M,N)*sizeof(double)); - - alpha = 1.0; - - if (M >= N) { - /* Perform Q = Q * R */ - cblas_ztrmm( CblasColMajor, CblasRight, CblasUpper, CblasNoTrans, CblasNonUnit, M, N, CBLAS_SADDR(alpha), R, LDR, Q, LDQ); - } - else { - /* Perform Q = L * Q */ - cblas_ztrmm( CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, M, N, CBLAS_SADDR(alpha), R, LDR, Q, LDQ); - } - - /* Compute the Residual */ - CORE_zgeadd( ChamNoTrans, M, N, -1., A, LDA, 1., Q, LDQ ); - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Q, LDQ, work ); - Anorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, A, LDA, work ); - - if (M >= N) { - printf("============\n"); - printf("Checking the QR Factorization \n"); - printf("-- ||A-QR||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - else { - printf("============\n"); - printf("Checking the LQ Factorization \n"); - printf("-- ||A-LQ||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - - if (isnan(Rnorm / (Anorm * N *eps)) || isinf(Rnorm / (Anorm * N *eps)) || (Rnorm / (Anorm * N * eps) > 60.0) ) { - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else { - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(work); - - return info_factorization; -} diff --git a/new-testing/testing_zgeqrs.c b/testing/testing_zgeqrs.c similarity index 96% rename from new-testing/testing_zgeqrs.c rename to testing/testing_zgeqrs.c index 899701e2af6ddcd03bdc72b24aaa81f052a5761a..c107f7bb6109776b62ac94992df58bd17fba68a9 100644 --- a/new-testing/testing_zgeqrs.c +++ b/testing/testing_zgeqrs.c @@ -2,21 +2,21 @@ * * @file testing_zgeqrs.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgeqrs testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-10 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" #include "control/common.h" @@ -123,7 +123,7 @@ void testing_zgeqrs_init( void ) { test_zgeqrs.name = "zgeqrs"; - test_zgeqrs.helper = "zgeqrs"; + test_zgeqrs.helper = "General QR solve"; test_zgeqrs.params = zgeqrs_params; test_zgeqrs.output = zgeqrs_output; test_zgeqrs.outchk = zgeqrs_outchk; diff --git a/new-testing/testing_zgesv.c b/testing/testing_zgesv.c similarity index 94% rename from new-testing/testing_zgesv.c rename to testing/testing_zgesv.c index c3731f1d72f680db947fd81b4316805e6cb72e05..529c7e0f8afb7da8a6c8073bf3bb94f465248305 100644 --- a/new-testing/testing_zgesv.c +++ b/testing/testing_zgesv.c @@ -2,21 +2,21 @@ * * @file testing_zgesv.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgesv testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-12 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -108,7 +108,7 @@ void testing_zgesv_init( void ) { test_zgesv.name = "zgesv"; - test_zgesv.helper = "zgesv"; + test_zgesv.helper = "General linear system solve (LU without pivoting)"; test_zgesv.params = zgesv_params; test_zgesv.output = zgesv_output; test_zgesv.outchk = zgesv_outchk; diff --git a/testing/testing_zgesv_incpiv.c b/testing/testing_zgesv_incpiv.c deleted file mode 100644 index 1102e50887bec7422e3c4bfc68da7e0f97cb54ab..0000000000000000000000000000000000000000 --- a/testing/testing_zgesv_incpiv.c +++ /dev/null @@ -1,259 +0,0 @@ -/** - * - * @file testing_zgesv_incpiv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgesv_incpiv testing - * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Bilel Hadri, Hatem Ltaief - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @author Lucas Barros de Assis - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(int, int , CHAMELEON_Complex64_t *, int, CHAMELEON_Complex64_t *, CHAMELEON_Complex64_t *, int, double); - -int testing_zgesv_incpiv(int argc, char **argv) -{ - int hres = 0; - /* Check for valid arguments*/ - if (argc != 4){ - USAGE("GESV_INCPIV", "N LDA NRHS LDB", - " - N : the size of the matrix\n" - " - LDA : leading dimension of the matrix A\n" - " - NRHS : number of RHS\n" - " - LDB : leading dimension of the matrix B\n"); - return -1; - } - - int N = atoi(argv[0]); - int LDA = atoi(argv[1]); - int NRHS = atoi(argv[2]); - int LDB = atoi(argv[3]); - double eps; - int info_solution; - int i,j; - int LDAxN = LDA*N; - int LDBxNRHS = LDB*NRHS; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*(sizeof*A1)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*(sizeof*A2)); - CHAMELEON_Complex64_t *B1 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*(sizeof*B1)); - CHAMELEON_Complex64_t *B2 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*(sizeof*B2)); - CHAM_desc_t *L; - int *IPIV; - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2)|| (!B1) || (!B2) ) - { - free(A1); free(A2); - free(B1); free(B2); - printf("Out of Memory \n "); - return -2; - } - - eps = LAPACKE_dlamch_work( 'e' ); - - /*---------------------------------------------------------- - * TESTING ZGESV - */ - - /* Initialize A1 and A2 Matrix */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - for ( i = 0; i < N; i++) - for ( j = 0; j < N; j++) - A2[LDA*j+i] = A1[LDA*j+i]; - - /* Initialize B1 and B2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - for ( i = 0; i < N; i++) - for ( j = 0; j < NRHS; j++) - B2[LDB*j+i] = B1[LDB*j+i]; - - /* CHAMELEON ZGESV */ - CHAMELEON_Alloc_Workspace_zgesv_incpiv(N, &L, &IPIV, 1, 1); - CHAMELEON_zgesv_incpiv(N, NRHS, A2, LDA, L, IPIV, B2, LDB); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON INCPIV ZGESV ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the factorization and the solution */ - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)){ - printf("***************************************************\n"); - printf(" ---- TESTING INCPIV ZGESV ............... PASSED !\n"); - printf("***************************************************\n"); - } - else{ - hres++; - printf("************************************************\n"); - printf(" - TESTING INCPIV ZGESV ... FAILED !\n"); - printf("************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZGETRF + ZGETRS - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - for ( i = 0; i < N; i++) - for ( j = 0; j < N; j++) - A2[LDA*j+i] = A1[LDA*j+i]; - - /* Initialize B1 and B2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - for ( i = 0; i < N; i++) - for ( j = 0; j < NRHS; j++) - B2[LDB*j+i] = B1[LDB*j+i]; - - /* Cham routines */ - CHAMELEON_zgetrf_incpiv(N, N, A2, LDA, L, IPIV); - CHAMELEON_zgetrs_incpiv(ChamNoTrans, N, NRHS, A2, LDA, L, IPIV, B2, LDB); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGETRF + ZGETRS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the solution */ - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)){ - printf("***************************************************\n"); - printf(" ---- TESTING INCPIV ZGETRF + ZGETRS ..... PASSED !\n"); - printf("***************************************************\n"); - } - else{ - hres++; - printf("***************************************************\n"); - printf(" - TESTING INCPIV ZGETRF + ZGETRS ... FAILED !\n"); - printf("***************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZGETRF + ZTRSMPL + ZTRSM - */ - - /* Initialize A1 and A2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxN, A1); - for ( i = 0; i < N; i++) - for ( j = 0; j < N; j++) - A2[LDA*j+i] = A1[LDA*j+i]; - - /* Initialize B1 and B2 */ - LAPACKE_zlarnv_work(IONE, ISEED, LDBxNRHS, B1); - for ( i = 0; i < N; i++) - for ( j = 0; j < NRHS; j++) - B2[LDB*j+i] = B1[LDB*j+i]; - - /* CHAMELEON routines */ - CHAMELEON_zgetrf_incpiv(N, N, A2, LDA, L, IPIV); - CHAMELEON_ztrsmpl(N, NRHS, A2, LDA, L, IPIV, B2, LDB); - CHAMELEON_ztrsm(ChamLeft, ChamUpper, ChamNoTrans, ChamNonUnit, - N, NRHS, 1.0, A2, LDA, B2, LDB); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON INCPIV ZGETRF + ZTRSMPL + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the solution */ - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)){ - printf("***************************************************\n"); - printf(" ---- TESTING INCPIV ZGETRF + ZTRSMPL + ZTRSM ... PASSED !\n"); - printf("***************************************************\n"); - } - else{ - hres++; - printf("**************************************************\n"); - printf(" - TESTING INCPIV ZGETRF + ZTRSMPL + ZTRSM ... FAILED !\n"); - printf("**************************************************\n"); - } - - free(A1); free(A2); free(B1); free(B2); free(IPIV); - CHAMELEON_Dealloc_Workspace( &L ); - - return hres; -} - -/*------------------------------------------------------------------------ - * Check the accuracy of the solution of the linear system - */ - -static int check_solution(int N, int NRHS, CHAMELEON_Complex64_t *A1, int LDA, CHAMELEON_Complex64_t *B1, CHAMELEON_Complex64_t *B2, int LDB, double eps ) -{ - int info_solution; - double Rnorm, Anorm, Xnorm, Bnorm, result; - CHAMELEON_Complex64_t alpha, beta; - double *work = (double *)malloc(N*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - Xnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B2, LDB ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, N, A1, LDA ); - Bnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B1, LDB ); - - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, N, NRHS, N, CBLAS_SADDR(alpha), A1, LDA, B2, LDB, CBLAS_SADDR(beta), B1, LDB); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B1, LDB ); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The solution is CORRECT ! \n"); - info_solution = 0; - } - free(work); - return info_solution; -} diff --git a/testing/testing_zgesvd.c b/testing/testing_zgesvd.c deleted file mode 100644 index 4884ceca0cbfaf49795fe373f9ed61b408e02d89..0000000000000000000000000000000000000000 --- a/testing/testing_zgesvd.c +++ /dev/null @@ -1,360 +0,0 @@ -/** - * - * @file testing_zgesvd.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zgesvd testing - * - * @version 0.9.2 - * @author Azzam Haidar - * @author Hatem Ltaief - * @date 2016-12-09 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality( cham_side_t, int, int, CHAMELEON_Complex64_t*, int, double); -static int check_reduction(int, int, double*, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, int, CHAMELEON_Complex64_t*, int, double); -static int check_solution(int, double*, double*, double); - -int testing_zgesvd(int argc, char **argv) -{ - int tree = 0; - - if ( argc < 1 ){ - goto usage; - } else { - tree = atoi(argv[0]); - } - - /* Check for number of arguments*/ - if ( ((tree == 0) && (argc != 4)) || - ((tree != 0) && (argc != 5)) ){ - usage: - USAGE("GESVD", "MODE M N LDA [RH]", - " - MODE : 0: flat, 1: tree (RH needed)\n" - " - M : number of rows of the matrix A\n" - " - N : number of columns of the matrix A\n" - " - LDA : leading dimension of the matrix A\n" - " - RH : Size of each subdomains\n"); - return -1; - } - - int M = atoi(argv[1]); - int N = atoi(argv[2]); - int LDA = atoi(argv[3]); - int rh; - if ( tree ) { - rh = atoi(argv[4]); - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_MODE, ChamTreeHouseholder); - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_SIZE, rh); - } - - if (LDA < M){ - printf("LDA should be >= M !\n"); - return -1; - } - - double eps = LAPACKE_dlamch_work('e'); - double dmax = 1.0; - cham_job_t jobu = ChamVec; - cham_job_t jobvt = ChamVec; - int info_orthou = 0; - int info_orthovt = 0; - int info_solution = 0; - int info_reduction = 0; - int minMN = min(M, N); - int mode = 4; - double rcond = (double) minMN; - int INFO=-1; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - double *S1 = (double *) malloc(minMN*sizeof(double)); - double *S2 = (double *) malloc(minMN*sizeof(double)); - CHAMELEON_Complex64_t *work = (CHAMELEON_Complex64_t *)malloc(3*max(M, N)* sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = NULL; - CHAMELEON_Complex64_t *U = NULL; - CHAMELEON_Complex64_t *VT = NULL; - CHAM_desc_t *T; - - /* Check if unable to allocate memory */ - if ( (!A1) || (!S1) || (!S2) || (!work) ) { - free(A1); free(work); - free(S1); free(S2); - printf("Out of Memory \n "); - return -2; - } - - /* TODO: check problem with workspace!!! */ - CHAMELEON_Alloc_Workspace_zgesvd(M, N, &T, 1, 1); - - /*---------------------------------------------------------- - * TESTING ZGESVD - */ - /* Initialize A1 */ - LAPACKE_zlatms_work( LAPACK_COL_MAJOR, M, N, - chameleon_lapack_const(ChamDistUniform), ISEED, - chameleon_lapack_const(ChamNonsymPosv), S1, mode, rcond, - dmax, M, N, - chameleon_lapack_const(ChamNoPacking), A1, LDA, work ); - free(work); - - /* Copy A1 for check */ - if ( (jobu == ChamVec) && (jobvt == ChamVec) ) { - A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A1, LDA, A2, LDA); - } - if ( jobu == ChamVec ) { - U = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', M, M, 0., 1., U, M); - } - if ( jobvt == ChamVec ) { - VT = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', N, N, 0., 1., VT, N); - } - - /* CHAMELEON ZGESVD */ - INFO = CHAMELEON_zgesvd(jobu, jobvt, M, N, A1, LDA, S2, T, U, M, VT, N); - if( INFO != 0 ){ - printf(" CHAMELEON_zgesvd returned with error code %d\n",INFO); - goto fin; - } - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZGESVD ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - - /* Check the orthogonality, reduction and the singular values */ - if ( jobu == ChamVec ) - info_orthou = check_orthogonality(ChamLeft, M, M, U, M, eps); - - if ( jobvt == ChamVec ) - info_orthovt = check_orthogonality(ChamRight, N, N, VT, N, eps); - - if ( (jobu == ChamVec) && (jobvt == ChamVec) ) - info_reduction = check_reduction(M, N, S2, A2, LDA, U, M, VT, N, eps); - - info_solution = check_solution(minMN, S1, S2, eps); - - if ( (info_solution == 0) & (info_orthou == 0) & - (info_orthovt == 0) & (info_reduction == 0) ) { - if (M >= N) { - printf("***************************************************\n"); - printf(" ---- TESTING ZGESVD .. M >= N ........... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" ---- TESTING ZGESVD .. M < N ............ PASSED !\n"); - printf("***************************************************\n"); - } - } - else { - if (M >= N) { - printf("************************************************\n"); - printf(" - TESTING ZGESVD .. M >= N .. FAILED !\n"); - printf("************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZGESVD .. M < N .. FAILED !\n"); - printf("************************************************\n"); - } - } - -fin: - if ( A2 != NULL ) free(A2); - if ( U != NULL ) free(U); - if ( VT != NULL ) free(VT); - free(A1); free(S1); free(S2); - CHAMELEON_Dealloc_Workspace(&T); - - return 0; -} - -/*------------------------------------------------------------------- - * Check the orthogonality of U VT - */ -static int check_orthogonality(cham_side_t side, int M, int N, CHAMELEON_Complex64_t *Q, int LDQ, double eps) -{ - double done = 1.0; - double mdone = -1.0; - double normQ, result; - int info_ortho; - int minMN = min(M, N); - double *work = (double *)malloc(minMN*sizeof(double)); - - /* Build the idendity matrix */ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', minMN, minMN, 0., 1., Id, minMN); - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, done, Q, LDQ, mdone, Id, N); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, done, Q, LDQ, mdone, Id, M); - - normQ = LAPACKE_zlansy_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamInfNorm), 'U', minMN, Id, minMN, work); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||Q||_oo=%e\n", normQ ); - - result = normQ / (M * eps); - if (side == ChamLeft) - { - printf(" ======================================================\n"); - printf(" ||Id-U'*U||_oo / (M*eps) : %e \n", result ); - printf(" ======================================================\n"); - } - else - { - printf(" ======================================================\n"); - printf(" ||Id-VT'*VT||_oo / (M*eps) : %e \n", result ); - printf(" ======================================================\n"); - } - - if ( isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho = 1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho = 0; - } - - free(work); free(Id); - - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the bidiagonal reduction - */ -static int check_reduction(int M, int N, double *S, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *U, int LDU, CHAMELEON_Complex64_t *VT, int LDVT, double eps ) -{ - CHAMELEON_Complex64_t zone = 1.0; - CHAMELEON_Complex64_t mzone = -1.0; - double Anorm, Rnorm, result; - int info_reduction; - int i; - int maxMN = max(M, N); - int minMN = min(M, N); - - CHAMELEON_Complex64_t *TEMP = (CHAMELEON_Complex64_t *)malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M *N *sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(maxMN*sizeof(double)); - - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamUpperLower), M, N, A, LDA, Residual, M); - - if ( M >= N ) { - /* Compute TEMP = SIGMA * Vt */ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', N, N, VT, LDVT, TEMP, N); - for (i = 0; i < minMN; i++){ - cblas_zdscal(N, S[i], TEMP + i, N); - } - - /* Compute Residual = A - U * (SIGMA * VT) */ - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, N, - CBLAS_SADDR(mzone), U, LDU, - TEMP, minMN, - CBLAS_SADDR(zone), Residual, M); - } - else { - /* Compute TEMP = U * SIGMA */ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, M, U, LDU, TEMP, M); - for (i = 0; i < minMN; i++){ - cblas_zdscal(M, S[i], TEMP + i*M, 1); - } - - /* Compute Residual = A - (U * SIGMA) * VT */ - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, M, - CBLAS_SADDR(mzone), TEMP, M, - VT, LDVT, - CBLAS_SADDR(zone), Residual, M); - } - - /* Compute the norms */ - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamOneNorm), M, N, Residual, M, work); - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamOneNorm), M, N, A, LDA, work); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%e\n||A - U*SIGMA*VT||_oo=%e\n", Anorm, Rnorm ); - - result = Rnorm / ( Anorm * maxMN * eps); - printf(" ======================================================\n"); - printf(" ||A-U*SIGMA*V'||_oo/(||A||_oo.N.eps) : %e \n", result ); - printf(" ======================================================\n"); - - if ( isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- Reduction is suspicious ! \n"); - info_reduction = 1; - } - else { - printf("-- Reduction is CORRECT ! \n"); - info_reduction = 0; - } - - free(TEMP); - free(Residual); - free(work); - - return info_reduction; -} - -/*------------------------------------------------------------ - * Check the eigenvalues - */ -static int check_solution(int N, double *E1, double *E2, double eps) -{ - int info_solution, i; - double resid; - double maxtmp; - double maxel = fabs( fabs(E1[0]) - fabs(E2[0]) ); - double maxeig = max( fabs(E1[0]), fabs(E2[0]) ); - for (i = 1; i < N; i++){ - resid = fabs(fabs(E1[i])-fabs(E2[i])); - maxtmp = max(fabs(E1[i]), fabs(E2[i])); - - /* Update */ - maxeig = max(maxtmp, maxeig); - maxel = max(resid, maxel ); - } - - maxel = maxel / (maxeig * N * eps); - printf(" ======================================================\n"); - printf(" | S - singularcomputed | / (|S| * N * eps) : %e \n", maxel ); - printf(" ======================================================\n"); - - if ( isnan(maxel) || isinf(maxel) || (maxel > 100) ) { - printf("-- The singular values are suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The singular values are CORRECT ! \n"); - info_solution = 0; - } - return info_solution; -} diff --git a/new-testing/testing_zgetrf.c b/testing/testing_zgetrf.c similarity index 92% rename from new-testing/testing_zgetrf.c rename to testing/testing_zgetrf.c index ebfea504ea0d63dee0b943da7cbed2ccecaa9809..f71c404d4106aaea142432943e036925ea27bdb3 100644 --- a/new-testing/testing_zgetrf.c +++ b/testing/testing_zgetrf.c @@ -2,21 +2,21 @@ * * @file testing_zgetrf.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrf testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -84,7 +84,7 @@ void testing_zgetrf_init( void ) { test_zgetrf.name = "zgetrf"; - test_zgetrf.helper = "zgetrf"; + test_zgetrf.helper = "General factorization (LU without pivoting)"; test_zgetrf.params = zgetrf_params; test_zgetrf.output = zgetrf_output; test_zgetrf.outchk = zgetrf_outchk; diff --git a/new-testing/testing_zgetrs.c b/testing/testing_zgetrs.c similarity index 94% rename from new-testing/testing_zgetrs.c rename to testing/testing_zgetrs.c index b773d9ddffb9bc540f2b2ff001322f1d0e504c74..9b864944a30a41aeafc4b9e2d59c1ccf15175e3d 100644 --- a/new-testing/testing_zgetrs.c +++ b/testing/testing_zgetrs.c @@ -2,22 +2,22 @@ * * @file testing_zgetrs.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zgetrs testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -98,7 +98,7 @@ void testing_zgetrs_init( void ) { test_zgetrs.name = "zgetrs"; - test_zgetrs.helper = "zgetrs"; + test_zgetrs.helper = "General triangular solve (LU without pivoting)"; test_zgetrs.params = zgetrs_params; test_zgetrs.output = zgetrs_output; test_zgetrs.outchk = zgetrs_outchk; diff --git a/testing/testing_zheevd.c b/testing/testing_zheevd.c deleted file mode 100644 index d38d3e68f68b4ad8eb483ec5cd1bd9cabbac8028..0000000000000000000000000000000000000000 --- a/testing/testing_zheevd.c +++ /dev/null @@ -1,292 +0,0 @@ -/** - * - * @file testing_zheevd.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zheevd testing - * - * @version 0.9.2 - * @author Hatem Ltaief - * @author Azzam Haidar - * @date 2016-12-09 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_orthogonality(int, int, CHAMELEON_Complex64_t*, int, double); -static int check_reduction(cham_uplo_t, int, int, CHAMELEON_Complex64_t*, double*, int, CHAMELEON_Complex64_t*, double); -static int check_solution(int, double*, double*, double); - -int testing_zheevd(int argc, char **argv) -{ - /* Check for number of arguments*/ - if (argc != 3) { - USAGE("HEEVD", "MODE N LDA", - " - MODE : mode used to generate the matrix\n" - " - N : size of the matrix A\n" - " - LDA : leading dimension of the matrix A\n"); - return -1; - } - - int mode = atoi(argv[0]); - int N = atoi(argv[1]); - int LDA = atoi(argv[2]); - double eps = LAPACKE_dlamch_work('e'); - double dmax = 1.0; - double rcond = 1.0e6; - int INFO = -1; - - cham_uplo_t uplo = ChamUpper; - cham_job_t vec = ChamVec; - int info_ortho = 0; - int info_solution = 0; - int info_reduction = 0; - int LDAxN = LDA * N; - - CHAMELEON_Complex64_t *A1 = NULL; - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDAxN * sizeof(CHAMELEON_Complex64_t)); - double *W1 = (double *)malloc(N * sizeof(double)); - double *W2 = (double *)malloc(N * sizeof(double)); - CHAMELEON_Complex64_t *work = (CHAMELEON_Complex64_t *)malloc(3* N * sizeof(CHAMELEON_Complex64_t)); - CHAM_desc_t *T; - - /* Check if unable to allocate memory */ - if ( (!A2) || (!W1) || (!W2) || !(work) ) - { - free(A2); - free(W1); free(W2); - free(work); - printf("Out of Memory \n "); - return -2; - } - - CHAMELEON_Alloc_Workspace_zheevd(N, N, &T, 1, 1); - - /*---------------------------------------------------------- - * TESTING ZHEEVD - */ - /* Initialize A1 */ - if (mode == 0){ - int i; - for (i=0; i<N; i++){ - W1[i] = (double )i+1; - } - } - LAPACKE_zlatms_work( LAPACK_COL_MAJOR, N, N, - chameleon_lapack_const(ChamDistSymmetric), ISEED, - chameleon_lapack_const(ChamHermGeev), W1, mode, rcond, - dmax, N, N, - chameleon_lapack_const(ChamNoPacking), A2, LDA, work ); - - /* - * Sort the eigenvalue because when computing the tridiag - * and then the eigenvalue of the DSTQR are sorted. - * So to avoid testing fail when having good results W1 should be sorted - */ - LAPACKE_dlasrt_work( 'I', N, W1 ); - - if ( vec == ChamVec ) { - A1 = (CHAMELEON_Complex64_t *)malloc(LDAxN*sizeof(CHAMELEON_Complex64_t)); - - /* Copy A2 into A1 */ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', N, N, A2, LDA, A1, LDA); - } - - /* - * CHAMELEON ZHEEVD - */ - INFO = CHAMELEON_zheevd(vec, uplo, N, A2, LDA, W2, T); - - if (INFO != 0) { - printf(" ERROR OCCURED INFO %d\n", INFO); - goto fin; - } - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZHEEVD ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the orthogonality, reduction and the eigen solutions */ - if (vec == ChamVec) { - info_ortho = check_orthogonality(N, N, A2, LDA, eps); - info_reduction = check_reduction(uplo, N, 1, A1, W2, LDA, A2, eps); - } - info_solution = check_solution(N, W1, W2, eps); - - if ( (info_solution == 0) & (info_ortho == 0) & (info_reduction == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZHEEVD ...................... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZHEEVD ... FAILED !\n"); - printf("************************************************\n"); - } - - fin: - CHAMELEON_Dealloc_Workspace(&T); - free(A2); - free(W1); - free(W2); - free(work); - if (A1 != NULL) free(A1); - - return 0; -} - -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ -static int check_orthogonality(int M, int N, CHAMELEON_Complex64_t *Q, int LDQ, double eps) -{ - double done = 1.0; - double mdone = -1.0; - double normQ, result; - int info_ortho; - int minMN = min(M, N); - double *work = (double *)malloc(minMN*sizeof(double)); - - /* Build the idendity matrix */ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', minMN, minMN, 0., 1., Id, minMN); - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, done, Q, LDQ, mdone, Id, minMN); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, done, Q, LDQ, mdone, Id, minMN); - - normQ = LAPACKE_zlanhe_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamInfNorm), 'U', minMN, Id, minMN, work); - - result = normQ / (minMN * eps); - printf(" ======================================================\n"); - printf(" ||Id-Q'*Q||_oo / (minMN*eps) : %15.3E \n", result ); - printf(" ======================================================\n"); - - if ( isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; - } - free(work); free(Id); - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the reduction - */ -static int check_reduction(cham_uplo_t uplo, int N, int bw, CHAMELEON_Complex64_t *A, double *D, int LDA, CHAMELEON_Complex64_t *Q, double eps ) -{ - (void) bw; - CHAMELEON_Complex64_t zone = 1.0; - CHAMELEON_Complex64_t mzone = -1.0; - CHAMELEON_Complex64_t *TEMP = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(N*sizeof(double)); - double Anorm, Rnorm, result; - int info_reduction; - int i; - - /* Compute TEMP = Q * LAMBDA */ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamUpperLower), N, N, Q, LDA, TEMP, N); - - for (i = 0; i < N; i++){ - cblas_zdscal(N, D[i], &(TEMP[i*N]), 1); - } - /* Compute Residual = A - Q * LAMBDA * Q^H */ - /* A is Hermetian but both upper and lower - * are assumed valable here for checking - * otherwise it need to be symetrized before - * checking. - */ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamUpperLower), N, N, A, LDA, Residual, N); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasConjTrans, N, N, N, CBLAS_SADDR(mzone), TEMP, N, Q, LDA, CBLAS_SADDR(zone), Residual, N); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamOneNorm), N, N, Residual, N, work); - Anorm = LAPACKE_zlanhe_work(LAPACK_COL_MAJOR, chameleon_lapack_const(ChamOneNorm), chameleon_lapack_const(uplo), N, A, LDA, work); - - result = Rnorm / ( Anorm * N * eps); - if ( uplo == ChamLower ){ - printf(" ======================================================\n"); - printf(" ||A-Q*LAMBDA*Q'||_oo/(||A||_oo.N.eps) : %15.3E \n", result ); - printf(" ======================================================\n"); - }else{ - printf(" ======================================================\n"); - printf(" ||A-Q'*LAMBDA*Q||_oo/(||A||_oo.N.eps) : %15.3E \n", result ); - printf(" ======================================================\n"); - } - - if ( isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- Reduction is suspicious ! \n"); - info_reduction = 1; - } - else { - printf("-- Reduction is CORRECT ! \n"); - info_reduction = 0; - } - - free(TEMP); free(Residual); - free(work); - - return info_reduction; -} -/*------------------------------------------------------------ - * Check the eigenvalues - */ -static int check_solution(int N, double *E1, double *E2, double eps) -{ - int info_solution, i; - double resid; - double maxtmp; - double maxel = fabs( fabs(E1[0]) - fabs(E2[0]) ); - double maxeig = max( fabs(E1[0]), fabs(E2[0]) ); - - for (i = 1; i < N; i++){ - resid = fabs(fabs(E1[i])-fabs(E2[i])); - maxtmp = max(fabs(E1[i]), fabs(E2[i])); - - /* Update */ - maxeig = max(maxtmp, maxeig); - maxel = max(resid, maxel ); - } - - maxel = maxel / (maxeig * N * eps); - printf(" ======================================================\n"); - printf(" | D - eigcomputed | / (|D| * N * eps) : %15.3E \n", maxel ); - printf(" ======================================================\n"); - - if ( isnan(maxel) || isinf(maxel) || (maxel > 100) ) { - printf("-- The eigenvalues are suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The eigenvalues are CORRECT ! \n"); - info_solution = 0; - } - return info_solution; -} diff --git a/testing/testing_zhemm.c b/testing/testing_zhemm.c index ae952609160af5fb4ad2cb8e503c755ea1864450..90269d45220068d91e72afd257905891c39fbed7 100644 --- a/testing/testing_zhemm.c +++ b/testing/testing_zhemm.c @@ -2,198 +2,128 @@ * * @file testing_zhemm.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zhemm testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zhemm(int argc, char **argv) +int +testing_zhemm( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 7 ){ - USAGE("HEMM", "alpha beta M N K LDA LDB LDC", - " - alpha : alpha coefficient \n" - " - beta : beta coefficient \n" - " - M : number of rows of matrices A and C \n" - " - N : number of columns of matrices B and C \n" - " - LDA : leading dimension of matrix A \n" - " - LDB : leading dimension of matrix B \n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am; + int hres = 0; + CHAM_desc_t *descA, *descB, *descC, *descCinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( side == ChamLeft ) ? M : N ) ); + int LDB = run_arg_get_int( args, "LDB", M ); + int LDC = run_arg_get_int( args, "LDC", M ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + double bump = testing_dalea(); + bump = run_arg_get_double( args, "bump", bump ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zhemm( side, M, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculate the dimensions according to the side */ + if ( side == ChamLeft ) { + Am = M; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int M = atoi(argv[2]); - int N = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDB = atoi(argv[5]); - int LDC = atoi(argv[6]); - int MNmax = max(M, N); - - double eps; - int info_solution; - int i, j, s, u; - int LDAxM = LDA*MNmax; - int LDBxN = LDB*N; - int LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxM*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!C) || (!Cinit) || (!Cfinal) ) - { - free(A); free(B); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZHEMM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZHEMM - */ - - /* Initialize A */ - CHAMELEON_zplghe( (double)0., ChamUpperLower, MNmax, A, LDA, 51 ); - - /* Initialize B */ - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - - /* Initialize C */ - LAPACKE_zlarnv_work(IONE, ISEED, LDCxN, C); - - for (s=0; s<2; s++) { - for (u=0; u<2; u++) { - - /* Initialize Cinit / Cfinal */ - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cinit[LDC*j+i] = C[LDC*j+i]; - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cfinal[LDC*j+i] = C[LDC*j+i]; - - /* CHAMELEON ZHEMM */ - CHAMELEON_zhemm(side[s], uplo[u], M, N, alpha, A, LDA, B, LDB, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(side[s], uplo[u], M, N, alpha, A, LDA, B, LDB, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZHEMM (%5s, %5s) ....... PASSED !\n", sidestr[s], uplostr[u]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZHEMM (%s, %s) ... FAILED !\n", sidestr[s], uplostr[u]); hres++; - printf("************************************************\n"); - } - } + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, Am, 0, 0, Am, Am, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplghe_Tile( bump, uplo, descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + CHAMELEON_zplrnt_Tile( descC, seedC ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_zhemm_Tile( side, uplo, alpha, descA, descB, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + CHAMELEON_zplrnt_Tile( descCinit, seedC ); + + hres += + check_zsymm( args, ChamHermitian, side, uplo, alpha, descA, descB, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(B); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zhemm; +const char *zhemm_params[] = { "nb", "side", "uplo", "m", "n", "lda", "ldb", "ldc", + "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; +const char *zhemm_output[] = { NULL }; +const char *zhemm_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zhemm_init( void ) __attribute__( ( constructor ) ); +void +testing_zhemm_init( void ) { - int info_solution, NrowA; - double Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm; - double eps; - CHAMELEON_Complex64_t beta_const; - double result; - double *work = (double *)malloc(max(M, N)* sizeof(double)); - - beta_const = (CHAMELEON_Complex64_t)-1.0; - - NrowA = (side == ChamLeft) ? M : N; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', NrowA, NrowA, A, LDA, work); - Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, B, LDB, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work); - - cblas_zhemm(CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, M, N, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - cblas_zaxpy(LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Bnorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n",Rnorm,Anorm,Bnorm,Cinitnorm,Cchamnorm,Clapacknorm); - - result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZHEMM \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||B||_oo+||C||_oo).N.eps) = %e \n", result ); - - if ( isinf(Clapacknorm) || isinf(Cchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - free(work); - return info_solution; + test_zhemm.name = "zhemm"; + test_zhemm.helper = "Hermitian matrix-matrix multiply"; + test_zhemm.params = zhemm_params; + test_zhemm.output = zhemm_output; + test_zhemm.outchk = zhemm_outchk; + test_zhemm.params_list = "nb;P;side;uplo;m;n;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; + test_zhemm.fptr = testing_zhemm; + test_zhemm.next = NULL; + + testing_register( &test_zhemm ); } diff --git a/testing/testing_zher2k.c b/testing/testing_zher2k.c index b8128bf9f74eb93442db704a4477b0fe2e3fbaa0..0c2214be92265185a2a208b1da0f86d86edd236e 100644 --- a/testing/testing_zher2k.c +++ b/testing/testing_zher2k.c @@ -2,198 +2,130 @@ * * @file testing_zher2k.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zher2k testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 - * @precisions normal z -> c + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 + * @precisions normal z -> z c * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - double beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); - +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zher2k(int argc, char **argv) +int +testing_zher2k( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 7 ){ - USAGE("HER2K", "alpha beta M N LDA LDB LDC", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - N : number of columns and rows of matrix C and number of row of matrix A and B\n" - " - K : number of columns of matrix A and B\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am, An; + int hres = 0; + CHAM_desc_t *descA, *descB, *descC, *descCinit; + + /* Read arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDB = run_arg_get_int( args, "LDB", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDC = run_arg_get_int( args, "LDC", N ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + double beta = testing_dalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + double bump = testing_dalea(); + bump = run_arg_get_double( args, "bump", bump ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zher2k( K, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_double( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculate the dimensions according to the transposition */ + if ( trans == ChamNoTrans ) { + Am = N; + An = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - double beta = (double) atol(argv[1]); - int N = atoi(argv[2]); - int K = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDB = atoi(argv[5]); - int LDC = atoi(argv[6]); - int NKmax = max(N, K); - - double eps; - int info_solution; - int u, t; - size_t LDAxK = LDA*NKmax; - size_t LDBxK = LDB*NKmax; - size_t LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!C) || (!Cinit) || (!Cfinal) ){ - free(A); free(B); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = K; + An = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZHER2K ROUTINE ------- \n"); - printf(" Size of the Matrix C %d by %d\n", N, K); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZHER2K - */ - - /* Initialize A,B */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxK, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxK, B); - - /* Initialize C */ - CHAMELEON_zplghe( (double)0., ChamUpperLower, N, C, LDC, 51 ); - - for (u=0; u<2; u++) { - for (t=0; t<3; t++) { - if (trans[t] == ChamTrans) continue; - - memcpy(Cinit, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Cfinal, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZHER2K */ - CHAMELEON_zher2k(uplo[u], trans[t], N, K, alpha, A, LDA, B, LDB, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(uplo[u], trans[t], N, K, - alpha, A, LDA, B, LDB, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZHER2K (%5s, %s) ........... PASSED !\n", uplostr[u], transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZHER2K (%5s, %s) ... FAILED !\n", uplostr[u], transstr[t]); hres++; - printf("************************************************\n"); - } - } + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + + /* Fill the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + CHAMELEON_zplghe_Tile( bump, uplo, descC, seedC ); + + /* Calculate the product */ + START_TIMING( t ); + hres = CHAMELEON_zher2k_Tile( uplo, trans, alpha, descA, descB, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Check the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + CHAMELEON_zplghe_Tile( bump, uplo, descCinit, seedC ); + + hres += + check_zsyrk( args, ChamHermitian, uplo, trans, alpha, descA, descB, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(B); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zher2k; +const char *zher2k_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldb", "ldc", + "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; +const char *zher2k_output[] = { NULL }; +const char *zher2k_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - double beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zher2k_init( void ) __attribute__( ( constructor ) ); +void +testing_zher2k_init( void ) { - int info_solution; - double Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t beta_const; - - double *work = (double *)malloc(max(N, K)* sizeof(double)); - - beta_const = -1.0; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, A, LDA, work); - Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, B, LDB, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Ccham, LDC, work); - - cblas_zher2k(CblasColMajor, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - N, K, CBLAS_SADDR(alpha), A, LDA, B, LDB, (beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - cblas_zaxpy(LDC*N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n", - Rnorm, Anorm, Cinitnorm, Cchamnorm, Clapacknorm); - - result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps); - printf("============\n"); - printf("Checking the norm of the difference against reference ZHER2K \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||C||_oo).N.eps) = %e \n", result); - - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; + test_zher2k.name = "zher2k"; + test_zher2k.helper = "Hermitian matrix-matrix rank 2k update"; + test_zher2k.params = zher2k_params; + test_zher2k.output = zher2k_output; + test_zher2k.outchk = zher2k_outchk; + test_zher2k.params_list = "nb;P;trans;uplo;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; + test_zher2k.fptr = testing_zher2k; + test_zher2k.next = NULL; + + testing_register( &test_zher2k ); } diff --git a/testing/testing_zherk.c b/testing/testing_zherk.c index 72c026a4b3b94fd78dfd5d0641b5c7bec4a43fff..99fbe8e1c5a90f7a20a59fd1dd0d3c4846ca4191 100644 --- a/testing/testing_zherk.c +++ b/testing/testing_zherk.c @@ -2,189 +2,125 @@ * * @file testing_zherk.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zherk testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 - * @precisions normal z -> c + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 + * @precisions normal z -> z c * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - double alpha, CHAMELEON_Complex64_t *A, int LDA, - double beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); - +#include "flops.h" +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zherk(int argc, char **argv) +int +testing_zherk( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 6 ){ - USAGE("HERK", "alpha beta M N LDA LDC", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - N : number of columns and rows of matrix C and number of row of matrix A\n" - " - K : number of columns of matrix A\n" - " - LDA : leading dimension of matrix A\n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am, An; + int hres = 0; + CHAM_desc_t *descA, *descC, *descCinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDC = run_arg_get_int( args, "LDC", N ); + double alpha = testing_dalea(); + double beta = testing_dalea(); + double bump = testing_dalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zherk( K, N ); + + alpha = run_arg_get_double( args, "alpha", alpha ); + beta = run_arg_get_double( args, "beta", beta ); + bump = run_arg_get_double( args, "bump", bump ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculates the dimensions according to the transposition */ + if ( trans == ChamNoTrans ) { + Am = N; + An = K; } - - double alpha = (double) atol(argv[0]); - double beta = (double) atol(argv[1]); - int N = atoi(argv[2]); - int K = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDC = atoi(argv[5]); - int NKmax = max(N, K); - - double eps; - int info_solution; - int u, t; - size_t LDAxK = LDA*NKmax; - size_t LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!C) || (!Cinit) || (!Cfinal) ){ - free(A); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = K; + An = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZHERK ROUTINE ------- \n"); - printf(" Size of the Matrix A %d by %d\n", N, K); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZHERK - */ - - /* Initialize A */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxK, A); - - /* Initialize C */ - CHAMELEON_zplgsy( (double)0., ChamUpperLower, N, C, LDC, 51 ); - - for (u=0; u<2; u++) { - for (t=0; t<3; t++) { - if (trans[t] == ChamTrans) continue; - - memcpy(Cinit, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Cfinal, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZHERK */ - CHAMELEON_zherk(uplo[u], trans[t], N, K, alpha, A, LDA, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(uplo[u], trans[t], N, K, - alpha, A, LDA, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZHERK (%5s, %s) ........... PASSED !\n", uplostr[u], transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZHERK (%5s, %s) ... FAILED !\n", uplostr[u], transstr[t]); hres++; - printf("************************************************\n"); - } - } + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplghe_Tile( bump, uplo, descC, seedC ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_zherk_Tile( uplo, trans, alpha, descA, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + CHAMELEON_zplghe_Tile( bump, uplo, descCinit, seedC ); + + hres += + check_zsyrk( args, ChamHermitian, uplo, trans, alpha, descA, NULL, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zherk; +const char *zherk_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldc", + "alpha", "beta", "seedA", "seedC", "bump", NULL }; +const char *zherk_output[] = { NULL }; +const char *zherk_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - double alpha, CHAMELEON_Complex64_t *A, int LDA, - double beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zherk_init( void ) __attribute__( ( constructor ) ); +void +testing_zherk_init( void ) { - int info_solution; - double Anorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm; - double eps; - CHAMELEON_Complex64_t beta_const; - double result; - double *work = (double *)malloc(max(N, K)* sizeof(double)); - - beta_const = -1.0; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, A, LDA, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Ccham, LDC, work); - - cblas_zherk(CblasColMajor, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - N, K, (alpha), A, LDA, (beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - cblas_zaxpy(LDC*N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n", - Rnorm, Anorm, Cinitnorm, Cchamnorm, Clapacknorm); - - result = Rnorm / ((Anorm + Cinitnorm) * N * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZHERK \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||C||_oo).N.eps) = %e \n", result); - - if ( isinf(Clapacknorm) || isinf(Cchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; + test_zherk.name = "zherk"; + test_zherk.helper = "Hermitian matrix-matrix rank k update"; + test_zherk.params = zherk_params; + test_zherk.output = zherk_output; + test_zherk.outchk = zherk_outchk; + test_zherk.params_list = "nb;P;trans;uplo;n;k;lda;ldc;alpha;beta;seedA;seedC;bump"; + test_zherk.fptr = testing_zherk; + test_zherk.next = NULL; + + testing_register( &test_zherk ); } diff --git a/new-testing/testing_zlacpy.c b/testing/testing_zlacpy.c similarity index 95% rename from new-testing/testing_zlacpy.c rename to testing/testing_zlacpy.c index a6119bf6e4c436615ae114ad45f41959d346f7e3..3b07824fc64747ebab916b4c099b5434814145c8 100644 --- a/new-testing/testing_zlacpy.c +++ b/testing/testing_zlacpy.c @@ -2,21 +2,21 @@ * * @file testing_zlacpy.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlacpy testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-04 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -117,7 +117,7 @@ void testing_zlacpy_init( void ) { test_zlacpy.name = "zlacpy"; - test_zlacpy.helper = "zlacpy"; + test_zlacpy.helper = "General matrix copy"; test_zlacpy.params = zlacpy_params; test_zlacpy.output = zlacpy_output; test_zlacpy.outchk = zlacpy_outchk; diff --git a/testing/testing_zlange.c b/testing/testing_zlange.c index 49e311615cfe75d9e064f3a1e2b6b02d494507f3..cbe523d370bb9db7b093f0cf0fa5f0dfbc14f325 100644 --- a/testing/testing_zlange.c +++ b/testing/testing_zlange.c @@ -2,246 +2,119 @@ * * @file testing_zlange.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlange testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.6.0 for CHAMELEON 0.9.2 - * @author Emmanuel Agullo - * @author Mathieu Faverge + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2014-11-16 + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zlange(int argc, char **argv) +static cham_fixdbl_t +flops_zlange( cham_normtype_t ntype, int M, int N ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc < 3) { - USAGE("LANGE", "M N LDA", - " - M : number of rows of matrices A and C\n" - " - N : number of columns of matrices B and C\n" - " - LDA : leading dimension of matrix A\n"); - return -1; - } - int M = atoi(argv[0]); - int N = atoi(argv[1]); - int LDA = atoi(argv[2]); - int LDAxN = LDA*N; - int n, u; - double eps; - - /* Allocate Data */ - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxN*sizeof(CHAMELEON_Complex64_t)); - double *work = (double*) malloc(max(M,N)*sizeof(double)); - double normcham, normlapack, result; - - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZLANGE ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZLANGE - */ - - /* Initialize A, B, C */ - CHAMELEON_zplrnt( M, N, A, LDA, 3436 ); - - /* CHAMELEON ZLANGE */ - for(n=0; n<4; n++) { - normcham = CHAMELEON_zlange(norm[n], M, N, A, LDA); - normlapack = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm[n]), M, N, A, LDA, work); - printf("LAPACK %e, CHAMELEON %e\n", normlapack, normcham); - result = fabs(normcham - normlapack) / (normlapack * eps); + cham_fixdbl_t flops = 0.; + double coefabs = 1.; +#if defined( PRECISION_z ) || defined( PRECISION_c ) + coefabs = 3.; +#endif - switch(norm[n]) { + switch ( ntype ) { case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; + flops = coefabs * M * N; break; case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; + flops = coefabs * M * N + M * ( N - 1 ); + break; + case ChamInfNorm: + flops = coefabs * M * N + N * ( M - 1 ); break; case ChamFrobeniusNorm: - /* Sum order on every element can differ */ - result = result / ((double)M * (double)N); + flops = ( coefabs + 1. ) * M * N; break; - } - - printf("***************************************************\n"); - if ( result < 1. ) { - printf(" ---- TESTING ZLANGE (%s)............... PASSED !\n", normstr[n]); - } - else { - hres++; - printf(" - TESTING ZLANGE (%s)... FAILED !\n", normstr[n]); - } - printf("***************************************************\n"); - - } - -#if defined(PRECISION_z) || defined(PRECISION_c) - /* CHAMELEON ZLANTR */ - for(n=1; n<3; n++) { - for(u=0; u<2; u++) { - int d; - for(d=0; d<2; d++) { - normcham = CHAMELEON_zlantr(norm[n], uplo[u], diag[d], M, N, A, LDA); - normlapack = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm[n]), chameleon_lapack_const(uplo[u]), - chameleon_lapack_const(diag[d]), M, N, A, LDA, work); - printf("LAPACK %e, CHAMELEON %e\n", normlapack, normcham); - - result = fabs(normcham - normlapack) / (normlapack * eps); - switch(norm[n]) { - case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; - break; - case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; - break; - case ChamFrobeniusNorm: - /* Sum oreder on every element can differ */ - result = result / ((double)M * (double)N); - break; - } - - printf("***************************************************\n"); - if ( result < 1. ) { - printf(" ---- TESTING ZLANTR (%s, %s, %s)......... PASSED !\n", - normstr[n], uplostr[u], diagstr[d]); - } - else { - hres++; - printf(" - TESTING ZLANTR (%s, %s, %s)... FAILED !\n", - normstr[n], uplostr[u], diagstr[d]); - } - printf("***************************************************\n"); - } - } - } -#endif - - /* CHAMELEON ZLANSY */ - for(n=0; n<4; n++) { - for(u=0; u<2; u++) { - normcham = CHAMELEON_zlansy(norm[n], uplo[u], min(M,N), A, LDA); - normlapack = LAPACKE_zlansy_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm[n]), chameleon_lapack_const(uplo[u]), min(M,N), A, LDA, work); - printf("LAPACK %e, CHAMELEON %e\n", normlapack, normcham); - - result = fabs(normcham - normlapack) / (normlapack * eps); - switch(norm[n]) { - case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; - break; - case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; - break; - case ChamFrobeniusNorm: - /* Sum oreder on every element can differ */ - result = result / ((double)M * (double)N); - break; - } - - printf("***************************************************\n"); - if ( result < 1. ) { - printf(" ---- TESTING ZLANSY (%s, %s)......... PASSED !\n", normstr[n], uplostr[u]); - } - else { - hres++; - printf(" - TESTING ZLANSY (%s, %s)... FAILED !\n", normstr[n], uplostr[u]); - } - printf("***************************************************\n"); - } + default:; } + return flops; +} -#if defined(PRECISION_z) || defined(PRECISION_c) - /* CHAMELEON ZLANHE */ - { - int j; - for (j=0; j<min(M,N); j++) { - A[j*LDA+j] -= I*cimag(A[j*LDA+j]); - } +int +testing_zlange( run_arg_list_t *args, int check ) +{ + static int run_id = 0; + int hres = 0; + double norm; + CHAM_desc_t *descA; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_normtype_t norm_type = run_arg_get_ntype( args, "norm", ChamMaxNorm ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int LDA = run_arg_get_int( args, "LDA", M ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zlange( norm_type, M, N ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Creates the matrix */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, M, N, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + + /* Calculates the norm */ + START_TIMING( t ); + norm = CHAMELEON_zlange_Tile( norm_type, descA ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( norm >= 0. ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + hres = check_znorm( args, ChamGeneral, norm_type, ChamUpperLower, ChamNonUnit, norm, descA ); } - for(n=0; n<4; n++) { - for(u=0; u<2; u++) { - normcham = CHAMELEON_zlanhe(norm[n], uplo[u], min(M,N), A, LDA); - normlapack = LAPACKE_zlanhe_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm[n]), chameleon_lapack_const(uplo[u]), min(M,N), A, LDA, work); - printf("LAPACK %e, CHAMELEON %e\n", normlapack, normcham); + CHAMELEON_Desc_Destroy( &descA ); - result = fabs(normcham - normlapack) / (normlapack * eps); - switch(norm[n]) { - case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; - break; - case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; - break; - case ChamFrobeniusNorm: - /* Sum oreder on every element can differ */ - result = result / ((double)M * (double)N); - break; - } + run_id++; + return hres; +} - printf("***************************************************\n"); - if ( result < 1. ) { - printf(" ---- TESTING ZLANHE (%s, %s)......... PASSED !\n", normstr[n], uplostr[u]); - } - else { - hres++; - printf(" - TESTING ZLANHE (%s, %s)... FAILED !\n", normstr[n], uplostr[u]); - } - printf("***************************************************\n"); - } - } -#endif +testing_t test_zlange; +const char *zlange_params[] = { "nb", "norm", "m", "n", "lda", "seedA", NULL }; +const char *zlange_output[] = { NULL }; +const char *zlange_outchk[] = { "RETURN", NULL }; - free(A); - free(work); - return hres; +/** + * @brief Testing registration function + */ +void testing_zlange_init( void ) __attribute__( ( constructor ) ); +void +testing_zlange_init( void ) +{ + test_zlange.name = "zlange"; + test_zlange.helper = "General matrix norm"; + test_zlange.params = zlange_params; + test_zlange.output = zlange_output; + test_zlange.outchk = zlange_outchk; + test_zlange.params_list = "nb;P;norm;m;n;lda;seedA"; + test_zlange.fptr = testing_zlange; + test_zlange.next = NULL; + + testing_register( &test_zlange ); } diff --git a/new-testing/testing_zlanhe.c b/testing/testing_zlanhe.c similarity index 94% rename from new-testing/testing_zlanhe.c rename to testing/testing_zlanhe.c index 4c942e39fb6f78ceef8737a319486fea4d94b0d7..14a313447cd69166a794639c19685d094700cbc1 100644 --- a/new-testing/testing_zlanhe.c +++ b/testing/testing_zlanhe.c @@ -2,21 +2,21 @@ * * @file testing_zlanhe.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlanhe testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-17 + * @date 2020-03-03 * @precisions normal z -> c * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -109,7 +109,7 @@ void testing_zlanhe_init( void ) { test_zlanhe.name = "zlanhe"; - test_zlanhe.helper = "zlanhe"; + test_zlanhe.helper = "Hermitian matrix norm"; test_zlanhe.params = zlanhe_params; test_zlanhe.output = zlanhe_output; test_zlanhe.outchk = zlanhe_outchk; diff --git a/new-testing/testing_zlansy.c b/testing/testing_zlansy.c similarity index 95% rename from new-testing/testing_zlansy.c rename to testing/testing_zlansy.c index 646a22c7e3d7e1ef98008d0b195c8cf032e48e5d..881e55901847313fa5b58ca3746049efa7ceed89 100644 --- a/new-testing/testing_zlansy.c +++ b/testing/testing_zlansy.c @@ -2,21 +2,21 @@ * * @file testing_zlansy.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlansy testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -109,7 +109,7 @@ void testing_zlansy_init( void ) { test_zlansy.name = "zlansy"; - test_zlansy.helper = "zlansy"; + test_zlansy.helper = "Symmetric matrix norm"; test_zlansy.params = zlansy_params; test_zlansy.output = zlansy_output; test_zlansy.outchk = zlansy_outchk; diff --git a/new-testing/testing_zlantr.c b/testing/testing_zlantr.c similarity index 95% rename from new-testing/testing_zlantr.c rename to testing/testing_zlantr.c index 947ade0d59d92688252d9a2dac6a103f731e61a4..3a764911b05987b9dab842b1a31d6f27a0001b44 100644 --- a/new-testing/testing_zlantr.c +++ b/testing/testing_zlantr.c @@ -2,21 +2,21 @@ * * @file testing_zlantr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlantr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2014-07-17 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -109,7 +109,7 @@ void testing_zlantr_init( void ) { test_zlantr.name = "zlantr"; - test_zlantr.helper = "zlantr"; + test_zlantr.helper = "Triangular matrix norm"; test_zlantr.params = zlantr_params; test_zlantr.output = zlantr_output; test_zlantr.outchk = zlantr_outchk; diff --git a/new-testing/testing_zlascal.c b/testing/testing_zlascal.c similarity index 95% rename from new-testing/testing_zlascal.c rename to testing/testing_zlascal.c index 86b0373a354bf816374e119d7547cfc28ac877fb..e0da00963a2ecbbf6c2da07f17ac2c7e692e7975 100644 --- a/new-testing/testing_zlascal.c +++ b/testing/testing_zlascal.c @@ -2,21 +2,21 @@ * * @file testing_zlascal.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlascal testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2014-07-13 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -112,7 +112,7 @@ void testing_zlascal_init( void ) { test_zlascal.name = "zlascal"; - test_zlascal.helper = "zlascal"; + test_zlascal.helper = "General matrix scaling"; test_zlascal.params = zlascal_params; test_zlascal.output = zlascal_output; test_zlascal.outchk = zlascal_outchk; diff --git a/new-testing/testing_zlauum.c b/testing/testing_zlauum.c similarity index 92% rename from new-testing/testing_zlauum.c rename to testing/testing_zlauum.c index db3d0fe398a0fa6141afb5d60fbd4ec8d1c03e31..82311bf7b0bb34689a4cfcb0a0738d87ebfb2b9d 100644 --- a/new-testing/testing_zlauum.c +++ b/testing/testing_zlauum.c @@ -2,21 +2,21 @@ * * @file testing_zlauum.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zlauum testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-26 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -90,7 +90,7 @@ void testing_zlauum_init( void ) { test_zlauum.name = "zlauum"; - test_zlauum.helper = "zlauum"; + test_zlauum.helper = "Trianguilar in-place matrix-matrix computation for Cholesky inversion"; test_zlauum.params = zlauum_params; test_zlauum.output = zlauum_output; test_zlauum.outchk = zlauum_outchk; diff --git a/testing/testing_zpemv.c b/testing/testing_zpemv.c deleted file mode 100644 index 0e35f56d57950857c1a582b4fdd9481723f73f03..0000000000000000000000000000000000000000 --- a/testing/testing_zpemv.c +++ /dev/null @@ -1,267 +0,0 @@ -/** - * - * @file testing_zpemv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon zpemv testing - * - * @version 0.9.2 - * @author Dulceneia Becker - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -/*-------------------------------------------------------------- - * Check the pemv - */ -static int check_solution(cham_trans_t trans, cham_store_t storev, - int M, int N, int L, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *X, int INCX, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Y0, int INCY0, - CHAMELEON_Complex64_t *Y, int INCY, - CHAMELEON_Complex64_t *W, double *Rnorm) -{ - int k; - double eps = LAPACKE_dlamch_work('e'); - double *work; - CHAMELEON_Complex64_t mzone = -1.0; - - /* Copy x to w */ - if ( trans == ChamNoTrans ) { - k = N; - } else { - k = M; - } - - work = (double *)malloc(k * sizeof(double)); - cblas_zcopy(k, Y0, INCY0, W, 1); - - /* w = a A x + b w */ - cblas_zgemv(CblasColMajor, (CBLAS_TRANSPOSE)trans, - M, N, - CBLAS_SADDR(alpha), A, LDA, - X, INCX, - CBLAS_SADDR(beta), W, 1); - - /* y - w */ - cblas_zaxpy(k, CBLAS_SADDR(mzone), Y, INCY, W, 1); - - /* Max Norm */ - *Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'm', 1, k, W, 1, work); - - if ( (*Rnorm / (M*N)) > eps) { - return 1; - } else { - return 0; - } - - (void)L; (void)storev; -} - -/*-------------------------------------------------------------- - * Testing ZPEMV - */ -int testing_zpemv(int argc, char **argv) -{ - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 1) { - USAGE("PEMV", "N", - " - N : number of columns\n"); - return -1; - } - - /* Args */ - int arg_n = atoi(argv[0]); - - /* Local variables */ - CHAMELEON_Complex64_t *A, *X, *Y, *A0, *Y0, *work; - CHAMELEON_Complex64_t alpha, beta, alpha0, beta0; - int n = arg_n; - int lda = arg_n; - - int info_solution = 0; - int i, j, k, t; - int nbtests = 0; - int nfails = 0; - cham_store_t storev; - int l = 0; - int m = n; - int incx = 1; - int incy = 1; - char *cstorev; - double rnorm; - double eps = LAPACKE_dlamch_work('e'); - - /* Allocate Data */ - A = (CHAMELEON_Complex64_t *)malloc(lda*n*sizeof(CHAMELEON_Complex64_t)); - A0 = (CHAMELEON_Complex64_t *)malloc(lda*n*sizeof(CHAMELEON_Complex64_t)); - X = (CHAMELEON_Complex64_t *)malloc(lda*n*sizeof(CHAMELEON_Complex64_t)); - Y = (CHAMELEON_Complex64_t *)malloc(lda*n*sizeof(CHAMELEON_Complex64_t)); - Y0 = (CHAMELEON_Complex64_t *)malloc( n*sizeof(CHAMELEON_Complex64_t)); - work = (CHAMELEON_Complex64_t *)malloc( 2*n*sizeof(CHAMELEON_Complex64_t)); - - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha0); - LAPACKE_zlarnv_work(1, ISEED, 1, &beta0 ); - - /* Check if unable to allocate memory */ - if ( (!A) || (!A0) || (!X) || (!Y) || (!Y0) || (!work) ) { - free(A); free(A0); - free(X); free(Y); free(Y0); - free(work); - printf("Out of Memory \n "); - return -2; - } - - /* Initialize Data */ - CHAMELEON_zplrnt(n, n, A, lda, 479 ); - CHAMELEON_zplrnt(n, n, X, lda, 320 ); - CHAMELEON_zplrnt(n, 1, Y0, n, 573 ); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZPEMV ROUTINE ------- \n"); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf(" The relative machine precision (eps) is %e \n",eps); - printf(" Computational tests pass if scaled residual is less than eps.\n"); - printf("\n"); - - nfails = 0; - for (i=0; i<6; i++) { - - /* m and n cannot be greater than lda (arg_n) */ - switch (i) { - case 0: l = 0; m = arg_n; n = m; break; - case 1: l = 0; m = arg_n; n = arg_n/2; break; /**/ - case 2: l = arg_n; m = l; n = l; break; - case 3: l = arg_n/2; m = l; n = arg_n; break; - case 4: l = arg_n/2; m = arg_n-l; n = l; break; - case 5: l = arg_n/3; m = arg_n-l; n = arg_n/2; break; /**/ - } - - /* Colwise ConjTrans & Rowwise NoTrans */ -#if defined(PRECISION_z) || defined(PRECISION_c) - for (t=0; t<3; t++) -#else - for (t=0; t<2; t++) -#endif - { - /* Swap m and n for transpose cases */ - if ( t == 1 ) { - k = m; m = n; n = k; - } - - LAPACKE_zlacpy_work( LAPACK_COL_MAJOR, 'A', m, n, - A, lda, A0, lda); - - if ( trans[t] == ChamNoTrans ) { - storev = ChamRowwise; - cstorev = storevstr[0]; - - /* zeroed the upper right triangle */ - int64_t i, j; - for (j=(n-l); j<n; j++) { - for (i=0; i<(j-(n-l)); i++) { - A0[i+j*lda] = 0.0; - } - } - } - else { - storev = ChamColumnwise; - cstorev = storevstr[1]; - - /* zeroed the lower left triangle */ - int64_t i, j; - for (j=0; j<(l-1); j++) { - for (i=(m-l+1+j); i<m; i++) { - A0[i+j*lda] = 0.0; - } - } - } - - for (j=0; j<3; j++) { - - /* Choose alpha and beta */ - alpha = ( j==1 ) ? 0.0 : alpha0; - beta = ( j==2 ) ? 0.0 : beta0; - - /* incx and incy: 1 or lda */ - for (k=0; k<4; k++) { - switch (k) { - case 0: incx = 1; incy = 1; break; - case 1: incx = 1; incy = lda; break; - case 2: incx = lda; incy = 1; break; - case 3: incx = lda; incy = lda; break; - } - - /* initialize Y with incy */ - cblas_zcopy(n, Y0, 1, Y, incy); - - /* ZPEMV */ - CORE_zpemv( trans[t], storev, m, n, l, - alpha, A, lda, - X, incx, - beta, Y, incy, - work); - - /* Check the solution */ - info_solution = check_solution(trans[t], storev, - m, n, l, - alpha, A0, lda, - X, incx, - beta, Y0, 1, - Y, incy, - work, &rnorm); - - if ( info_solution != 0 ) { - nfails++; - printf("Failed: t=%s, s=%s, M=%3d, N=%3d, L=%3d, alpha=%e, incx=%3d, beta=%e, incy=%3d, rnorm=%e\n", - transstr[t], cstorev, m, n, l, creal(alpha), incx, creal(beta), incy, rnorm ); - } - nbtests++; - } - } - } - } - - if ( nfails ) - printf("%d / %d tests failed\n", nfails, nbtests); - - printf("***************************************************\n"); - if (nfails == 0) { - printf(" ---- TESTING ZPEMV ...... PASSED !\n"); - } - else { - printf(" ---- TESTING ZPEMV ... FAILED !\n"); hres++; - } - printf("***************************************************\n"); - - free( A0 ); - free( A ); - free( X ); - free( Y0 ); - free( Y ); - - return hres; -} diff --git a/testing/testing_zposv.c b/testing/testing_zposv.c index 25f740afbcb8dfe92c702af6400bc00d52c554a0..8d26d7b2168f47c7e134daf55f0c01543b3acaff 100644 --- a/testing/testing_zposv.c +++ b/testing/testing_zposv.c @@ -2,318 +2,120 @@ * * @file testing_zposv.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zposv testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Bilel Hadri, Hatem Ltaief - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int -check_factorization( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, - cham_uplo_t uplo, double eps ); -static int -check_solution( int N, int NRHS, CHAMELEON_Complex64_t *A1, int LDA, - CHAMELEON_Complex64_t *B1, CHAMELEON_Complex64_t *B2, int LDB, double eps ); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zposv(int argc, char **argv) +static cham_fixdbl_t +flops_zposv( int N, int NRHS ) { - int hres = 0; - - /* Check for number of arguments*/ - if (argc != 4){ - USAGE("POSV", "N LDA NRHS LDB", - " - N : the size of the matrix\n" - " - LDA : leading dimension of the matrix A\n" - " - NRHS : number of RHS\n" - " - LDB : leading dimension of the RHS B\n"); - return -1; - } - - int N = atoi(argv[0]); - int LDA = atoi(argv[1]); - int NRHS = atoi(argv[2]); - int LDB = atoi(argv[3]); - double eps; - cham_uplo_t uplo; - int info_solution, info_factorization; - cham_trans_t trans1, trans2; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B1 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B2 = (CHAMELEON_Complex64_t *)malloc(LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2)|| (!B1) || (!B2) ) - { - free(A1); free(A2); - free(B1); free(B2); - printf("Out of Memory \n "); - return -2; - } - - eps = LAPACKE_dlamch_work( 'e' ); - - uplo = ChamUpper; - trans1 = uplo == ChamUpper ? ChamConjTrans : ChamNoTrans; - trans2 = uplo == ChamUpper ? ChamNoTrans : ChamConjTrans; - - /*------------------------------------------------------------- - * TESTING ZPOSV - */ - - /* Initialize A1 and A2 for Symmetric Positive Matrix */ - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A1, LDA, 51 ); - CHAMELEON_zlacpy( ChamUpperLower, N, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - CHAMELEON_zplrnt( N, NRHS, B1, LDB, 371 ); - CHAMELEON_zlacpy( ChamUpperLower, N, NRHS, B1, LDB, B2, LDB ); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZPOSV ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* CHAMELEON ZPOSV */ - CHAMELEON_zposv(uplo, N, NRHS, A2, LDA, B2, LDB); - - /* Check the factorization and the solution */ - info_factorization = check_factorization( N, A1, A2, LDA, uplo, eps); - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ( (info_solution == 0) && (info_factorization == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZPOSV ...................... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" - TESTING ZPOSV ... FAILED !\n"); hres++; - printf("***************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZPOTRF + ZPOTRS - */ - - /* Initialize A1 and A2 for Symmetric Positif Matrix */ - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A1, LDA, 51 ); - CHAMELEON_zlacpy( ChamUpperLower, N, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - CHAMELEON_zplrnt( N, NRHS, B1, LDB, 371 ); - CHAMELEON_zlacpy( ChamUpperLower, N, NRHS, B1, LDB, B2, LDB ); - - /* Cham routines */ - CHAMELEON_zpotrf(uplo, N, A2, LDA); - CHAMELEON_zpotrs(uplo, N, NRHS, A2, LDA, B2, LDB); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZPOTRF + ZPOTRS ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the factorization and the solution */ - info_factorization = check_factorization( N, A1, A2, LDA, uplo, eps); - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)){ - printf("***************************************************\n"); - printf(" ---- TESTING ZPOTRF + ZPOTRS ............ PASSED !\n"); - printf("***************************************************\n"); - } - else{ - printf("****************************************************\n"); - printf(" - TESTING ZPOTRF + ZPOTRS ... FAILED !\n"); - printf("****************************************************\n"); - } - - /*------------------------------------------------------------- - * TESTING ZPOTRF + ZPTRSM + ZTRSM - */ - - /* Initialize A1 and A2 for Symmetric Positif Matrix */ - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A1, LDA, 51 ); - CHAMELEON_zlacpy( ChamUpperLower, N, N, A1, LDA, A2, LDA ); - - /* Initialize B1 and B2 */ - CHAMELEON_zplrnt( N, NRHS, B1, LDB, 371 ); - CHAMELEON_zlacpy( ChamUpperLower, N, NRHS, B1, LDB, B2, LDB ); - - /* CHAMELEON routines */ - CHAMELEON_zpotrf(uplo, N, A2, LDA); - CHAMELEON_ztrsm(ChamLeft, uplo, trans1, ChamNonUnit, - N, NRHS, 1.0, A2, LDA, B2, LDB); - CHAMELEON_ztrsm(ChamLeft, uplo, trans2, ChamNonUnit, - N, NRHS, 1.0, A2, LDA, B2, LDB); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZPOTRF + ZTRSM + ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* Check the factorization and the solution */ - info_factorization = check_factorization( N, A1, A2, LDA, uplo, eps); - info_solution = check_solution(N, NRHS, A1, LDA, B1, B2, LDB, eps); - - if ((info_solution == 0)&(info_factorization == 0)){ - printf("***************************************************\n"); - printf(" ---- TESTING ZPOTRF + ZTRSM + ZTRSM ..... PASSED !\n"); - printf("***************************************************\n"); - } - else{ - printf("***************************************************\n"); - printf(" - TESTING ZPOTRF + ZTRSM + ZTRSM ... FAILED !\n"); - printf("***************************************************\n"); - } - - free(A1); free(A2); free(B1); free(B2); - - return hres; + cham_fixdbl_t flops = flops_zpotrf( N ) + flops_zpotrs( N, NRHS ); + return flops; } - -/*------------------------------------------------------------------------ - * Check the factorization of the matrix A2 - */ -static int -check_factorization( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, - cham_uplo_t uplo, double eps ) +int +testing_zposv( run_arg_list_t *args, int check ) { - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha; - int info_factorization; - int i,j; - - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L1 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L2 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(N*sizeof(double)); - - memset((void*)L1, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L2, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - - alpha= 1.0; - - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,' ', N, N, A1, LDA, Residual, N); - - /* Dealing with L'L or U'U */ - if (uplo == ChamUpper){ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasLeft, CblasUpper, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - else{ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasRight, CblasLower, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - - /* Compute the Residual || A -L'L|| */ - for (i = 0; i < N; i++) - for (j = 0; j < N; j++) - Residual[j*N+i] = L2[j*N+i] - Residual[j*N+i]; - - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, N, Residual, N ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, N, A1, LDA ); - - printf("============\n"); - printf("Checking the Cholesky Factorization \n"); - printf("-- ||L'L-A||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - - if ( isnan(Rnorm/(Anorm*N*eps)) || isinf(Rnorm/(Anorm*N*eps)) || (Rnorm/(Anorm*N*eps) > 60.0) ){ - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else{ - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; + static int run_id = 0; + int hres = 0; + CHAM_desc_t *descA, *descX; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int NRHS = run_arg_get_int( args, "NRHS", 1 ); + int LDA = run_arg_get_int( args, "LDA", N ); + int LDB = run_arg_get_int( args, "LDB", N ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zposv( N, NRHS ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); + CHAMELEON_Desc_Create( + &descX, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, NRHS, 0, 0, N, NRHS, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplghe_Tile( (double)N, uplo, descA, seedA ); + CHAMELEON_zplrnt_Tile( descX, seedB ); + + /* Calculates the solution */ + START_TIMING( t ); + hres = CHAMELEON_zposv_Tile( uplo, descA, descX ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the factorisation and residue */ + if ( check ) { + CHAM_desc_t *descA0, *descB; + + /* Check the factorization */ + descA0 = CHAMELEON_Desc_Copy( descA, NULL ); + CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); + + hres += check_zxxtrf( args, ChamHermitian, uplo, descA0, descA ); + + /* Check the solve */ + descB = CHAMELEON_Desc_Copy( descX, NULL ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + + CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); + hres += check_zsolve( args, ChamHermitian, ChamNoTrans, uplo, descA0, descX, descB ); + + CHAMELEON_Desc_Destroy( &descA0 ); + CHAMELEON_Desc_Destroy( &descB ); } - free(Residual); free(L1); free(L2); free(work); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descX ); - return info_factorization; + run_id++; + return hres; } +testing_t test_zposv; +const char *zposv_params[] = { "nb", "uplo", "n", "nrhs", "lda", "ldb", "seedA", "seedB", NULL }; +const char *zposv_output[] = { NULL }; +const char *zposv_outchk[] = { "RETURN", NULL }; -/*------------------------------------------------------------------------ - * Check the accuracy of the solution of the linear system +/** + * @brief Testing registration function */ -static int -check_solution( int N, int NRHS, CHAMELEON_Complex64_t *A1, int LDA, - CHAMELEON_Complex64_t *B1, CHAMELEON_Complex64_t *B2, int LDB, double eps ) +void testing_zposv_init( void ) __attribute__( ( constructor ) ); +void +testing_zposv_init( void ) { - int info_solution; - double Rnorm, Anorm, Xnorm, Bnorm, result; - CHAMELEON_Complex64_t alpha, beta; - double *work = (double *)malloc(N*sizeof(double)); - - alpha = 1.0; - beta = -1.0; - - Xnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B2, LDB ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, N, A1, LDA ); - Bnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B1, LDB ); - - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, N, NRHS, N, CBLAS_SADDR(alpha), A1, LDA, B2, LDB, CBLAS_SADDR(beta), B1, LDB); - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'i', N, NRHS, B1, LDB ); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else{ - printf("-- The solution is CORRECT ! \n"); - info_solution = 0; - } - - free(work); - - return info_solution; + test_zposv.name = "zposv"; + test_zposv.helper = "Hermitian positive definite linear system solve (Cholesky)"; + test_zposv.params = zposv_params; + test_zposv.output = zposv_output; + test_zposv.outchk = zposv_outchk; + test_zposv.params_list = "nb;P;uplo;n;nrhs;lda;ldb;seedA;seedB"; + test_zposv.fptr = testing_zposv; + test_zposv.next = NULL; + + testing_register( &test_zposv ); } diff --git a/new-testing/testing_zpotrf.c b/testing/testing_zpotrf.c similarity index 92% rename from new-testing/testing_zpotrf.c rename to testing/testing_zpotrf.c index 2b930b49d1700427205bb57a83936b0be712d50f..eb24d9517b254d7899b5c448b4de3274caef7f8c 100644 --- a/new-testing/testing_zpotrf.c +++ b/testing/testing_zpotrf.c @@ -2,21 +2,21 @@ * * @file testing_zpotrf.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrf testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-12 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -84,7 +84,7 @@ void testing_zpotrf_init( void ) { test_zpotrf.name = "zpotrf"; - test_zpotrf.helper = "zpotrf"; + test_zpotrf.helper = "Hermitian positive definite factorization (Cholesky)"; test_zpotrf.params = zpotrf_params; test_zpotrf.output = zpotrf_output; test_zpotrf.outchk = zpotrf_outchk; diff --git a/testing/testing_zpotri.c b/testing/testing_zpotri.c index dee0db509dcff60a90c4e17f9151c42fea54358b..85a2d1fe92aa5860b81576307fed1a301283eff5 100644 --- a/testing/testing_zpotri.c +++ b/testing/testing_zpotri.c @@ -2,248 +2,100 @@ * * @file testing_zpotri.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotri testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Hatem Ltaief - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int -check_factorization( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, - cham_uplo_t uplo, double eps ); -static int -check_inverse( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, - cham_uplo_t uplo, double eps ); - -int testing_zpotri(int argc, char **argv) -{ - int hres = 0; - - /* Check for number of arguments*/ - if (argc != 2){ - USAGE("POTRI", "N LDA", - " - N : the size of the matrix\n" - " - LDA : leading dimension of the matrix A\n"); - return -1; - } - - int N = atoi(argv[0]); - int LDA = atoi(argv[1]); - double eps; - cham_uplo_t uplo; - int info_inverse, info_factorization; - - CHAMELEON_Complex64_t *A1 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *A2 = (CHAMELEON_Complex64_t *)malloc(LDA*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *WORK = (CHAMELEON_Complex64_t *)malloc(2*LDA*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A1) || (!A2) || (!WORK) ) - { - free(A1); free(A2); - free(WORK); - printf("Out of Memory \n "); - return -2; - } - - eps = LAPACKE_dlamch_work( 'e' ); - - uplo = ChamUpper; - - /*------------------------------------------------------------- - * TESTING ZPOTRI - */ - - /* Initialize A1 and A2 for Symmetric Positif Matrix */ - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A1, LDA, 51 ); - CHAMELEON_zlacpy( ChamUpperLower, N, N, A1, LDA, A2, LDA ); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZPOTRI ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", N, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n", eps); - printf(" Computational tests pass if scaled residuals are less than 60.\n"); - - /* CHAMELEON ZPOTRF */ - CHAMELEON_zpotrf(uplo, N, A2, LDA); - - /* Check the factorization */ - info_factorization = check_factorization( N, A1, A2, LDA, uplo, eps); - - /* CHAMELEON ZPOTRI */ - CHAMELEON_zpotri(uplo, N, A2, LDA); +#include <assert.h> +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" - /* Check the inverse */ - info_inverse = check_inverse(N, A1, A2, LDA, uplo, eps); - - if ( (info_inverse == 0) && (info_factorization == 0) ) { - printf("***************************************************\n"); - printf(" ---- TESTING ZPOTRI ..................... PASSED !\n"); - printf("***************************************************\n"); - } - else { - printf("***************************************************\n"); - printf(" - TESTING ZPOTRI ... FAILED !\n"); hres++; - printf("***************************************************\n"); - } - - free(A1); free(A2); free(WORK); - - return hres; -} - - -/*------------------------------------------------------------------------ - * Check the factorization of the matrix A2 - */ -static int check_factorization(int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, cham_uplo_t uplo, double eps) +int +testing_zpotri( run_arg_list_t *args, int check ) { - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha; - int info_factorization; - int i,j; - - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L1 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L2 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(N*sizeof(double)); + static int run_id = 0; + int hres; + CHAM_desc_t *descA; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int LDA = run_arg_get_int( args, "LDA", N ); + int seedA = run_arg_get_int( args, "seedA", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zpotri( N ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); + + /* Initialise the matrix with the random values */ + CHAMELEON_zplghe_Tile( (double)N, uplo, descA, seedA ); + + hres = CHAMELEON_zpotrf_Tile( uplo, descA ); + assert( hres == 0 ); + + /* Calculates the inversed matrix */ + START_TIMING( t ); + hres += CHAMELEON_zpotri_Tile( uplo, descA ); + STOP_TIMING( t ); + + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); - memset((void*)L1, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L2, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - - alpha= 1.0; - - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,' ', N, N, A1, LDA, Residual, N); - - /* Dealing with L'L or U'U */ - if (uplo == ChamUpper){ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasLeft, CblasUpper, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - else{ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasRight, CblasLower, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - - /* Compute the Residual || A -L'L|| */ - for (i = 0; i < N; i++) - for (j = 0; j < N; j++) - Residual[j*N+i] = L2[j*N+i] - Residual[j*N+i]; - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', N, N, Residual, N, work ); - Anorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', N, N, A1, LDA, work ); + /* Check the inverse */ + if ( check ) { + CHAM_desc_t *descA0 = CHAMELEON_Desc_Copy( descA, NULL ); + CHAMELEON_zplghe_Tile( (double)N, uplo, descA0, seedA ); - printf("============\n"); - printf("Checking the Cholesky Factorization \n"); - printf("-- ||L'L-A||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); + hres += check_ztrtri( args, ChamHermitian, uplo, ChamNonUnit, descA0, descA ); - if ( isnan(Rnorm/(Anorm*N*eps)) || isinf(Rnorm/(Anorm*N*eps)) || (Rnorm/(Anorm*N*eps) > 60.0) ){ - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else{ - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; + CHAMELEON_Desc_Destroy( &descA0 ); } - free(Residual); free(L1); free(L2); free(work); + CHAMELEON_Desc_Destroy( &descA ); - return info_factorization; + run_id++; + return hres; } +testing_t test_zpotri; +const char *zpotri_params[] = { "nb", "uplo", "n", "lda", "seedA", NULL }; +const char *zpotri_output[] = { NULL }; +const char *zpotri_outchk[] = { "RETURN", NULL }; -/*------------------------------------------------------------------------ - * Check the accuracy of the computed inverse +/** + * @brief Testing registration function */ - -static int check_inverse(int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, cham_uplo_t uplo, double eps ) +void testing_zpotri_init( void ) __attribute__( ( constructor ) ); +void +testing_zpotri_init( void ) { - int info_inverse; - int i, j; - double Rnorm, Anorm, Ainvnorm, result; - CHAMELEON_Complex64_t alpha, beta, zone; - CHAMELEON_Complex64_t *work = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - - alpha = -1.0; - beta = 0.0; - zone = 1.0; - - /* Rebuild the other part of the inverse matrix */ - if(uplo == ChamUpper){ - for(j=0; j<N; j++) { - for(i=0; i<j; i++) { - *(A2+j+i*LDA) = *(A2+i+j*LDA); - } - } - cblas_zhemm(CblasColMajor, CblasLeft, CblasUpper, N, N, CBLAS_SADDR(alpha), A2, LDA, A1, LDA, CBLAS_SADDR(beta), work, N); - - } - else { - for(j=0; j<N; j++) { - for(i=j; i<N; i++) { - *(A2+j+i*LDA) = *(A2+i+j*LDA); - } - } - cblas_zhemm(CblasColMajor, CblasLeft, CblasLower, N, N, CBLAS_SADDR(alpha), A2, LDA, A1, LDA, CBLAS_SADDR(beta), work, N); - } - - /* Add the identity matrix to work */ - for(i=0; i<N; i++) - *(work+i+i*N) = *(work+i+i*N) + zone; - - Rnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'o', N, N, work, N ); - Anorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'o', N, N, A1, LDA ); - Ainvnorm = LAPACKE_zlange( LAPACK_COL_MAJOR, 'o', N, N, A2, LDA ); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) { - printf( "||A||_1=%f\n||Ainv||_1=%f\n||Id - A*Ainv||_1=%e\n", Anorm, Ainvnorm, Rnorm ); - } - - result = Rnorm / ( (Anorm*Ainvnorm)*N*eps ) ; - printf("============\n"); - printf("Checking the Residual of the inverse \n"); - printf("-- ||Id - A*Ainv||_1/((||A||_1||Ainv||_1).N.eps) = %e \n", result); - - if ( isnan(Ainvnorm) || isinf(Ainvnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The inverse is suspicious ! \n"); - info_inverse = 1; - } - else{ - printf("-- The inverse is CORRECT ! \n"); - info_inverse = 0; - } - - free(work); - - return info_inverse; + test_zpotri.name = "zpotri"; + test_zpotri.helper = "Hermitian positive definite matrix inversion"; + test_zpotri.params = zpotri_params; + test_zpotri.output = zpotri_output; + test_zpotri.outchk = zpotri_outchk; + test_zpotri.params_list = "nb;P;uplo;n;lda;seedA"; + test_zpotri.fptr = testing_zpotri; + test_zpotri.next = NULL; + + testing_register( &test_zpotri ); } diff --git a/new-testing/testing_zpotrs.c b/testing/testing_zpotrs.c similarity index 94% rename from new-testing/testing_zpotrs.c rename to testing/testing_zpotrs.c index ba3f104fc5c890d523ef9be2a179b0302d37ff0b..cd55d5742c184471e41c30edcbc8e08dc548212a 100644 --- a/new-testing/testing_zpotrs.c +++ b/testing/testing_zpotrs.c @@ -2,22 +2,22 @@ * * @file testing_zpotrs.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zpotrs testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-13 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -99,7 +99,7 @@ void testing_zpotrs_init( void ) { test_zpotrs.name = "zpotrs"; - test_zpotrs.helper = "zpotrs"; + test_zpotrs.helper = "Hermitian positive definite solve (Cholesky)"; test_zpotrs.params = zpotrs_params; test_zpotrs.output = zpotrs_output; test_zpotrs.outchk = zpotrs_outchk; diff --git a/testing/testing_zsymm.c b/testing/testing_zsymm.c index af7b75c8eda6dcef80c605ba99da28aaa5cfe72d..930f60e541accaa5924a87d5d58eaa3af249c5f9 100644 --- a/testing/testing_zsymm.c +++ b/testing/testing_zsymm.c @@ -2,200 +2,128 @@ * * @file testing_zsymm.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsymm testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int -check_solution( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC ); - -int testing_zsymm(int argc, char **argv) +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" + +int +testing_zsymm( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 7 ){ - USAGE("SYMM", "alpha beta M N K LDA LDB LDC", - " - alpha : alpha coefficient \n" - " - beta : beta coefficient \n" - " - M : number of rows of matrices A and C \n" - " - N : number of columns of matrices B and C \n" - " - LDA : leading dimension of matrix A \n" - " - LDB : leading dimension of matrix B \n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am; + int hres = 0; + CHAM_desc_t *descA, *descB, *descC, *descCinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int M = run_arg_get_int( args, "M", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( side == ChamLeft ) ? M : N ) ); + int LDB = run_arg_get_int( args, "LDB", M ); + int LDC = run_arg_get_int( args, "LDC", M ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + double bump = testing_dalea(); + bump = run_arg_get_double( args, "bump", bump ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zsymm( side, M, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculate the dimensions according to the side */ + if ( side == ChamLeft ) { + Am = M; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int M = atoi(argv[2]); - int N = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDB = atoi(argv[5]); - int LDC = atoi(argv[6]); - int MNmax = max(M, N); - - double eps; - int info_solution; - int i, j, s, u; - int LDAxM = LDA*MNmax; - int LDBxN = LDB*N; - int LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxM*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!C) || (!Cinit) || (!Cfinal) ) - { - free(A); free(B); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZSYMM ROUTINE ------- \n"); - printf(" Size of the Matrix %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZSYMM - */ - - /* Initialize A */ - CHAMELEON_zplgsy( (double)0., ChamUpperLower, MNmax, A, LDA, 51 ); - - /* Initialize B */ - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - - /* Initialize C */ - LAPACKE_zlarnv_work(IONE, ISEED, LDCxN, C); - - for (s=0; s<2; s++) { - for (u=0; u<2; u++) { - - /* Initialize Cinit / Cfinal */ - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cinit[LDC*j+i] = C[LDC*j+i]; - for ( i = 0; i < M; i++) - for ( j = 0; j < N; j++) - Cfinal[LDC*j+i] = C[LDC*j+i]; - - /* CHAMELEON ZSYMM */ - CHAMELEON_zsymm(side[s], uplo[u], M, N, alpha, A, LDA, B, LDB, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(side[s], uplo[u], M, N, alpha, A, LDA, B, LDB, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZSYMM (%5s, %5s) ....... PASSED !\n", sidestr[s], uplostr[u]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZSYMM (%s, %s) ... FAILED !\n", sidestr[s], uplostr[u]); hres++; - printf("************************************************\n"); - } - } + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, Am, 0, 0, Am, Am, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, N, 0, 0, M, N, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplgsy_Tile( bump, uplo, descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + CHAMELEON_zplrnt_Tile( descC, seedC ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_zsymm_Tile( side, uplo, alpha, descA, descB, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, M, N, P, Q ); + CHAMELEON_zplrnt_Tile( descCinit, seedC ); + + hres += + check_zsymm( args, ChamSymmetric, side, uplo, alpha, descA, descB, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(B); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zsymm; +const char *zsymm_params[] = { "nb", "side", "uplo", "m", "n", "lda", "ldb", "ldc", + "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; +const char *zsymm_output[] = { NULL }; +const char *zsymm_outchk[] = { "RETURN", NULL }; -static int -check_solution( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC ) +/** + * @brief Testing registration function + */ +void testing_zsymm_init( void ) __attribute__( ( constructor ) ); +void +testing_zsymm_init( void ) { - int info_solution, NrowA; - double Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm; - double eps; - CHAMELEON_Complex64_t beta_const; - double result; - double *work = (double *)malloc(max(M, N)* sizeof(double)); - - beta_const = (CHAMELEON_Complex64_t)-1.0; - - NrowA = (side == ChamLeft) ? M : N; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', NrowA, NrowA, A, LDA, work); - Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, B, LDB, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work); - - cblas_zsymm(CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, M, N, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - cblas_zaxpy(LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Bnorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n",Rnorm,Anorm,Bnorm,Cinitnorm,Cchamnorm,Clapacknorm); - - result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZSYMM \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||B||_oo+||C||_oo).N.eps) = %e \n", result ); - - if ( isinf(Clapacknorm) || isinf(Cchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - free(work); - return info_solution; + test_zsymm.name = "zsymm"; + test_zsymm.helper = "Symmetric matrix-matrix multiply"; + test_zsymm.params = zsymm_params; + test_zsymm.output = zsymm_output; + test_zsymm.outchk = zsymm_outchk; + test_zsymm.params_list = "nb;P;side;uplo;m;n;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; + test_zsymm.fptr = testing_zsymm; + test_zsymm.next = NULL; + + testing_register( &test_zsymm ); } diff --git a/testing/testing_zsyr2k.c b/testing/testing_zsyr2k.c index 0f16cbaffc192899494b48224a2f402e95548f55..afaf0224026af0d8e71ea0bcb7d540fe48481300 100644 --- a/testing/testing_zsyr2k.c +++ b/testing/testing_zsyr2k.c @@ -2,198 +2,130 @@ * * @file testing_zsyr2k.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyr2k testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 - * @precisions normal z -> c d s + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 + * @precisions normal z -> z c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); - +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zsyr2k(int argc, char **argv) +int +testing_zsyr2k( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 7 ){ - USAGE("SYR2K", "alpha beta M N LDA LDB LDC", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - N : number of columns and rows of matrix C and number of row of matrix A and B\n" - " - K : number of columns of matrix A and B\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am, An; + int hres = 0; + CHAM_desc_t *descA, *descB, *descC, *descCinit; + + /* Read arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDB = run_arg_get_int( args, "LDB", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDC = run_arg_get_int( args, "LDC", N ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + double bump = testing_dalea(); + bump = run_arg_get_double( args, "bump", bump ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zher2k( K, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculate the dimensions according to the transposition */ + if ( trans == ChamNoTrans ) { + Am = N; + An = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int N = atoi(argv[2]); - int K = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDB = atoi(argv[5]); - int LDC = atoi(argv[6]); - int NKmax = max(N, K); - - double eps; - int info_solution; - int u, t; - size_t LDAxK = LDA*NKmax; - size_t LDBxK = LDB*NKmax; - size_t LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!C) || (!Cinit) || (!Cfinal) ) - { - free(A); free(B); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = K; + An = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZSYR2K ROUTINE ------- \n"); - printf(" Size of the Matrix C %d by %d\n", N, K); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZSYR2K - */ - - /* Initialize A,B */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxK, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxK, B); - - /* Initialize C */ - CHAMELEON_zplgsy( (double)0., ChamUpperLower, N, C, LDC, 51 ); - - for (u=0; u<2; u++) { - for (t=0; t<2; t++) { - - memcpy(Cinit, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Cfinal, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZSYR2K */ - CHAMELEON_zsyr2k(uplo[u], trans[t], N, K, alpha, A, LDA, B, LDB, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(uplo[u], trans[t], N, K, - alpha, A, LDA, B, LDB, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZSYR2K (%5s, %s) ........... PASSED !\n", uplostr[u], transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZSYR2K (%5s, %s) ... FAILED !\n", uplostr[u], transstr[t]); hres++; - printf("************************************************\n"); - } - } + /* Create the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + + /* Fill the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + CHAMELEON_zplgsy_Tile( bump, uplo, descC, seedC ); + + /* Calculate the product */ + START_TIMING( t ); + hres = CHAMELEON_zsyr2k_Tile( uplo, trans, alpha, descA, descB, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Check the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + CHAMELEON_zplgsy_Tile( bump, uplo, descCinit, seedC ); + + hres += + check_zsyrk( args, ChamSymmetric, uplo, trans, alpha, descA, descB, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(B); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zsyr2k; +const char *zsyr2k_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldb", "ldc", + "alpha", "beta", "seedA", "seedB", "seedC", "bump", NULL }; +const char *zsyr2k_output[] = { NULL }; +const char *zsyr2k_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zsyr2k_init( void ) __attribute__( ( constructor ) ); +void +testing_zsyr2k_init( void ) { - int info_solution; - double Anorm, Bnorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t beta_const; - - double *work = (double *)malloc(max(N, K)* sizeof(double)); - - beta_const = -1.0; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, A, LDA, work); - Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, B, LDB, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Ccham, LDC, work); - - cblas_zsyr2k(CblasColMajor, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - N, K, CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - cblas_zaxpy(LDC*N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n", - Rnorm, Anorm, Cinitnorm, Cchamnorm, Clapacknorm); - - result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps); - printf("============\n"); - printf("Checking the norm of the difference against reference ZSYR2K \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||C||_oo).N.eps) = %e \n", result); - - if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; + test_zsyr2k.name = "zsyr2k"; + test_zsyr2k.helper = "Symmetrix matrix-matrix rank 2k update"; + test_zsyr2k.params = zsyr2k_params; + test_zsyr2k.output = zsyr2k_output; + test_zsyr2k.outchk = zsyr2k_outchk; + test_zsyr2k.params_list = "nb;P;trans;uplo;n;k;lda;ldb;ldc;alpha;beta;seedA;seedB;seedC;bump"; + test_zsyr2k.fptr = testing_zsyr2k; + test_zsyr2k.next = NULL; + + testing_register( &test_zsyr2k ); } diff --git a/testing/testing_zsyrk.c b/testing/testing_zsyrk.c index aadcfb491148315868309ea160617f7bdfc755b8..39b41042dd547b91960b367a72e109d4b2d8aec1 100644 --- a/testing/testing_zsyrk.c +++ b/testing/testing_zsyrk.c @@ -2,187 +2,124 @@ * * @file testing_zsyrk.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsyrk testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 - * @precisions normal z -> c d s + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 + * @precisions normal z -> z c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC); - +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_zsyrk(int argc, char **argv) +int +testing_zsyrk( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 6){ - USAGE("SYRK", "alpha beta M N LDA LDC", - " - alpha : alpha coefficient\n" - " - beta : beta coefficient\n" - " - N : number of columns and rows of matrix C and number of row of matrix A\n" - " - K : number of columns of matrix A\n" - " - LDA : leading dimension of matrix A\n" - " - LDC : leading dimension of matrix C\n"); - return -1; + static int run_id = 0; + int Am, An; + int hres = 0; + CHAM_desc_t *descA, *descC, *descCinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", ( ( trans == ChamNoTrans ) ? N : K ) ); + int LDC = run_arg_get_int( args, "LDC", N ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + CHAMELEON_Complex64_t beta = testing_zalea(); + CHAMELEON_Complex64_t bump = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedC = run_arg_get_int( args, "seedC", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_zsyrk( K, N ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + beta = run_arg_get_complex64( args, "beta", beta ); + bump = run_arg_get_complex64( args, "bump", bump ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculates the dimensions according to the transposition */ + if ( trans == ChamNoTrans ) { + Am = N; + An = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - CHAMELEON_Complex64_t beta = (CHAMELEON_Complex64_t) atol(argv[1]); - int N = atoi(argv[2]); - int K = atoi(argv[3]); - int LDA = atoi(argv[4]); - int LDC = atoi(argv[5]); - int NKmax = max(N, K); - - double eps; - int info_solution; - int u, t; - size_t LDAxK = LDA*NKmax; - size_t LDCxN = LDC*N; - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxK*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *C = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cinit = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Cfinal = (CHAMELEON_Complex64_t *)malloc(LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!C) || (!Cinit) || (!Cfinal) ){ - free(A); free(C); - free(Cinit); free(Cfinal); - printf("Out of Memory \n "); - return -2; + else { + Am = K; + An = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZSYRK ROUTINE ------- \n"); - printf(" Size of the Matrix A %d by %d\n", N, K); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZSYRK - */ - - /* Initialize A */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxK, A); - - /* Initialize C */ - CHAMELEON_zplgsy( (double)0., ChamUpperLower, N, C, LDC, 51 ); - - for (u=0; u<2; u++) { - for (t=0; t<2; t++) { - memcpy(Cinit, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Cfinal, C, LDCxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZSYRK */ - CHAMELEON_zsyrk(uplo[u], trans[t], N, K, alpha, A, LDA, beta, Cfinal, LDC); - - /* Check the solution */ - info_solution = check_solution(uplo[u], trans[t], N, K, - alpha, A, LDA, beta, Cinit, Cfinal, LDC); - - if (info_solution == 0) { - printf("***************************************************\n"); - printf(" ---- TESTING ZSYRK (%5s, %s) ........... PASSED !\n", uplostr[u], transstr[t]); - printf("***************************************************\n"); - } - else { - printf("************************************************\n"); - printf(" - TESTING ZSYRK (%5s, %s) ... FAILED !\n", uplostr[u], transstr[t]); hres++; - printf("************************************************\n"); - } - } + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, An, 0, 0, Am, An, P, Q ); + CHAMELEON_Desc_Create( + &descC, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplgsy_Tile( bump, uplo, descC, seedC ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_zsyrk_Tile( uplo, trans, alpha, descA, beta, descC ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descCinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDC, N, 0, 0, N, N, P, Q ); + CHAMELEON_zplgsy_Tile( bump, uplo, descCinit, seedC ); + + hres += + check_zsyrk( args, ChamSymmetric, uplo, trans, alpha, descA, NULL, beta, descCinit, descC ); + + CHAMELEON_Desc_Destroy( &descCinit ); } - free(A); free(C); - free(Cinit); free(Cfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descC ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution - */ +testing_t test_zsyrk; +const char *zsyrk_params[] = { "nb", "trans", "uplo", "n", "k", "lda", "ldc", + "alpha", "beta", "seedA", "seedC", "bump", NULL }; +const char *zsyrk_output[] = { NULL }; +const char *zsyrk_outchk[] = { "RETURN", NULL }; -static int check_solution(cham_uplo_t uplo, cham_trans_t trans, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Cref, CHAMELEON_Complex64_t *Ccham, int LDC) +/** + * @brief Testing registration function + */ +void testing_zsyrk_init( void ) __attribute__( ( constructor ) ); +void +testing_zsyrk_init( void ) { - int info_solution; - double Anorm, Cinitnorm, Cchamnorm, Clapacknorm, Rnorm; - double eps; - CHAMELEON_Complex64_t beta_const; - double result; - double *work = (double *)malloc(max(N, K)* sizeof(double)); - - beta_const = -1.0; - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', - (trans == ChamNoTrans) ? N : K, - (trans == ChamNoTrans) ? K : N, A, LDA, work); - Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Ccham, LDC, work); - - cblas_zsyrk(CblasColMajor, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - N, K, CBLAS_SADDR(alpha), A, LDA, CBLAS_SADDR(beta), Cref, LDC); - - Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - cblas_zaxpy(LDC*N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Cref, LDC, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Cinitnorm %e, Cchamnorm %e, Clapacknorm %e\n", - Rnorm, Anorm, Cinitnorm, Cchamnorm, Clapacknorm); - - result = Rnorm / ((Anorm + Cinitnorm) * N * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZSYRK \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||C||_oo).N.eps) = %e \n", result); - - if ( isinf(Clapacknorm) || isinf(Cchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - - free(work); - - return info_solution; + test_zsyrk.name = "zsyrk"; + test_zsyrk.helper = "Symmetrix matrix-matrix rank k update"; + test_zsyrk.params = zsyrk_params; + test_zsyrk.output = zsyrk_output; + test_zsyrk.outchk = zsyrk_outchk; + test_zsyrk.params_list = "nb;P;trans;uplo;n;k;lda;ldc;alpha;beta;seedA;seedC;bump"; + test_zsyrk.fptr = testing_zsyrk; + test_zsyrk.next = NULL; + + testing_register( &test_zsyrk ); } diff --git a/new-testing/testing_zsysv.c b/testing/testing_zsysv.c similarity index 95% rename from new-testing/testing_zsysv.c rename to testing/testing_zsysv.c index c4db9afd9786257588f84ed0178e438a825fe9f6..4f924d94b37291d7027692d7ff01b513489ed481 100644 --- a/new-testing/testing_zsysv.c +++ b/testing/testing_zsysv.c @@ -2,21 +2,21 @@ * * @file testing_zsysv.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsysv testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-12 + * @date 2020-03-03 * @precisions normal z -> c * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -109,7 +109,7 @@ void testing_zsysv_init( void ) { test_zsysv.name = "zsysv"; - test_zsysv.helper = "zsysv"; + test_zsysv.helper = "Symmetrix linear system solve"; test_zsysv.params = zsysv_params; test_zsysv.output = zsysv_output; test_zsysv.outchk = zsysv_outchk; diff --git a/new-testing/testing_zsytrf.c b/testing/testing_zsytrf.c similarity index 93% rename from new-testing/testing_zsytrf.c rename to testing/testing_zsytrf.c index 77c83064c58b2789eb1791d4c0b538804db9c456..c5a0fce835c8c800eef298e1c66ed2efd0e926a9 100644 --- a/new-testing/testing_zsytrf.c +++ b/testing/testing_zsytrf.c @@ -2,21 +2,21 @@ * * @file testing_zsytrf.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrf testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-12 + * @date 2020-03-03 * @precisions normal z -> c * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -84,7 +84,7 @@ void testing_zsytrf_init( void ) { test_zsytrf.name = "zsytrf"; - test_zsytrf.helper = "zsytrf"; + test_zsytrf.helper = "Symmetric trinagular factorization"; test_zsytrf.params = zsytrf_params; test_zsytrf.output = zsytrf_output; test_zsytrf.outchk = zsytrf_outchk; diff --git a/new-testing/testing_zsytrs.c b/testing/testing_zsytrs.c similarity index 94% rename from new-testing/testing_zsytrs.c rename to testing/testing_zsytrs.c index 129903ecb732559efa07d84a43db65c23f55b729..a3d1d628c5fb692069123b1abb77363e3ef906b0 100644 --- a/new-testing/testing_zsytrs.c +++ b/testing/testing_zsytrs.c @@ -2,22 +2,22 @@ * * @file testing_zsytrs.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zsytrs testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-13 + * @date 2020-03-03 * @precisions normal z -> c * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -99,7 +99,7 @@ void testing_zsytrs_init( void ) { test_zsytrs.name = "zsytrs"; - test_zsytrs.helper = "zsytrs"; + test_zsytrs.helper = "Symmetric triangular solve"; test_zsytrs.params = zsytrs_params; test_zsytrs.output = zsytrs_output; test_zsytrs.outchk = zsytrs_outchk; diff --git a/new-testing/testing_ztradd.c b/testing/testing_ztradd.c similarity index 96% rename from new-testing/testing_ztradd.c rename to testing/testing_ztradd.c index 758b4dad6b1f142e36975b9f80a1d7bab51c16e5..4aa6edfc50167ab1db7f1609fe34df20795ff56d 100644 --- a/new-testing/testing_ztradd.c +++ b/testing/testing_ztradd.c @@ -2,21 +2,21 @@ * * @file testing_ztradd.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztradd testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-06 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -156,7 +156,7 @@ void testing_ztradd_init( void ) { test_ztradd.name = "ztradd"; - test_ztradd.helper = "ztradd"; + test_ztradd.helper = "Triangular matrix-matrix addition"; test_ztradd.params = ztradd_params; test_ztradd.output = ztradd_output; test_ztradd.outchk = ztradd_outchk; diff --git a/testing/testing_ztrmm.c b/testing/testing_ztrmm.c index 950fa0c5bb490a1c609e83d09bfb44e5deb5e5a2..b8fe36443730c1f61aa616895a68feed8722e3cf 100644 --- a/testing/testing_ztrmm.c +++ b/testing/testing_ztrmm.c @@ -2,199 +2,121 @@ * * @file testing_ztrmm.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrmm testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int N, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_ztrmm(int argc, char **argv) +int +testing_ztrmm( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 5 ) { - USAGE("TRMM", "alpha M N LDA LDB", - " - alpha : alpha coefficient\n" - " - M : number of rows of matrices B\n" - " - N : number of columns of matrices B\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n"); - return -1; + static int run_id = 0; + int Bm, Bn; + int hres = 0; + CHAM_desc_t *descA, *descB, *descBinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + cham_diag_t diag = run_arg_get_diag( args, "diag", ChamNonUnit ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", N ); + int LDB = run_arg_get_int( args, "LDB", N ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_ztrmm( side, N, K ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculates the dimensions according to the side */ + if ( side == ChamLeft ) { + Bm = N; + Bn = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - int M = atoi(argv[1]); - int N = atoi(argv[2]); - int LDA = atoi(argv[3]); - int LDB = atoi(argv[4]); - - double eps; - int info_solution; - int s, u, t, d, i; - int LDAxM = LDA*max(M,N); - int LDBxN = LDB*max(M,N); - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxM*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Binit = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Bfinal = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!Binit) || (!Bfinal) ) - { - free(A); free(B); - free(Binit); free(Bfinal); - printf("Out of Memory \n "); - return -2; + else { + Bm = K; + Bn = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZTRMM ROUTINE ------- \n"); - printf(" Size of the Matrix B : %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZTRMM - */ - - /* Initialize A, B, C */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxM, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - for(i=0;i<max(M,N);i++) - A[LDA*i+i] = A[LDA*i+i] + 2.0; - - for (s=0; s<2; s++) { - for (u=0; u<2; u++) { -#if defined(PRECISION_z) || defined(PRECISION_c) - for (t=0; t<3; t++) { -#else - for (t=0; t<2; t++) { -#endif - for (d=0; d<2; d++) { - - memcpy(Binit, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Bfinal, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZTRMM */ - CHAMELEON_ztrmm(side[s], uplo[u], trans[t], diag[d], - M, N, alpha, A, LDA, Bfinal, LDB); - - /* Check the solution */ - info_solution = check_solution(side[s], uplo[u], trans[t], diag[d], - M, N, alpha, A, LDA, Binit, Bfinal, LDB); - - printf("***************************************************\n"); - if (info_solution == 0) { - printf(" ---- TESTING ZTRMM (%s, %s, %s, %s) ...... PASSED !\n", - sidestr[s], uplostr[u], transstr[t], diagstr[d]); - } - else { - printf(" ---- TESTING ZTRMM (%s, %s, %s, %s) ... FAILED !\n", - sidestr[s], uplostr[u], transstr[t], diagstr[d]); hres++; - } - printf("***************************************************\n"); - } - } - } + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); + + /* Fills the matrix with random values */ + CHAMELEON_zplrnt_Tile( descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_ztrmm_Tile( side, uplo, trans, diag, alpha, descA, descB ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descBinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); + CHAMELEON_zplrnt_Tile( descBinit, seedB ); + + hres += check_ztrmm( args, CHECK_TRMM, side, uplo, trans, diag, alpha, descA, descB, descBinit ); + + CHAMELEON_Desc_Destroy( &descBinit ); } - free(A); free(B); - free(Binit); free(Bfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution +testing_t test_ztrmm; +const char *ztrmm_params[] = { "nb", "trans", "side", "uplo", "diag", "n", "k", + "lda", "ldb", "alpha", "seedA", "seedB", NULL }; +const char *ztrmm_output[] = { NULL }; +const char *ztrmm_outchk[] = { "RETURN", NULL }; + +/** + * @brief Testing registration function */ -static int check_solution(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int N, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB) +void testing_ztrmm_init( void ) __attribute__( ( constructor ) ); +void +testing_ztrmm_init( void ) { - int info_solution; - double Anorm, Binitnorm, Bchamnorm, Blapacknorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t mzone = (CHAMELEON_Complex64_t)-1.0; - - double *work = (double *)malloc(max(M, N)* sizeof(double)); - int Am, An; - - if (side == ChamLeft) { - Am = M; An = M; - } else { - Am = N; An = N; - } - - Anorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', chameleon_lapack_const(uplo), chameleon_lapack_const(diag), - Am, An, A, LDA, work); - Binitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - Bchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bcham, LDB, work); - - cblas_ztrmm(CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - (CBLAS_DIAG)diag, M, N, CBLAS_SADDR(alpha), A, LDA, Bref, LDB); - - Blapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - - cblas_zaxpy(LDB * N, CBLAS_SADDR(mzone), Bcham, 1, Bref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Binitnorm %e, Bchamnorm %e, Blapacknorm %e\n", - Rnorm, Anorm, Binitnorm, Bchamnorm, Blapacknorm); - - result = Rnorm / ((Anorm + Blapacknorm) * max(M,N) * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZTRMM \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isinf(Blapacknorm) || isinf(Bchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - free(work); - - return info_solution; + test_ztrmm.name = "ztrmm"; + test_ztrmm.helper = "Triangular matrix-matrix multiply"; + test_ztrmm.params = ztrmm_params; + test_ztrmm.output = ztrmm_output; + test_ztrmm.outchk = ztrmm_outchk; + test_ztrmm.params_list = "nb;P;trans;side;uplo;diag;n;k;lda;ldb;alpha;seedA;seedB"; + test_ztrmm.fptr = testing_ztrmm; + test_ztrmm.next = NULL; + + testing_register( &test_ztrmm ); } diff --git a/testing/testing_ztrsm.c b/testing/testing_ztrsm.c index 975147964c36a11c2e417ec7ea9993a002af3279..bca5b7bd8d27d8215bd1bcad8e14319fe3b94f96 100644 --- a/testing/testing_ztrsm.c +++ b/testing/testing_ztrsm.c @@ -2,199 +2,122 @@ * * @file testing_ztrsm.c * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrsm testing * - * @version 0.9.2 - * @comment This file has been automatically generated - * from Plasma 2.5.0 for CHAMELEON 0.9.2 - * @author Mathieu Faverge - * @author Emmanuel Agullo - * @author Cedric Castagnede - * @date 2014-11-16 + * @version 1.0.0 + * @author Lucas Barros de Assis + * @date 2020-03-03 * @precisions normal z -> c d s * */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> - #include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "testing_zauxiliary.h" - -static int check_solution(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int N, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB); +#include "testings.h" +#include "testing_zcheck.h" +#include "flops.h" -int testing_ztrsm(int argc, char **argv) +int +testing_ztrsm( run_arg_list_t *args, int check ) { - int hres = 0; - /* Check for number of arguments*/ - if ( argc != 5 ) { - USAGE("TRSM", "alpha M N LDA LDB", - " - alpha : alpha coefficient\n" - " - M : number of rows of matrices B\n" - " - N : number of columns of matrices B\n" - " - LDA : leading dimension of matrix A\n" - " - LDB : leading dimension of matrix B\n"); - return -1; + static int run_id = 0; + int Bm, Bn; + int hres = 0; + CHAM_desc_t *descA, *descB, *descBinit; + + /* Reads arguments */ + int nb = run_arg_get_int( args, "nb", 320 ); + int P = parameters_getvalue_int( "P" ); + cham_trans_t trans = run_arg_get_trans( args, "trans", ChamNoTrans ); + cham_side_t side = run_arg_get_uplo( args, "side", ChamLeft ); + cham_uplo_t uplo = run_arg_get_uplo( args, "uplo", ChamUpper ); + cham_diag_t diag = run_arg_get_diag( args, "diag", ChamNonUnit ); + int N = run_arg_get_int( args, "N", 1000 ); + int K = run_arg_get_int( args, "K", N ); + int LDA = run_arg_get_int( args, "LDA", N ); + int LDB = run_arg_get_int( args, "LDB", N ); + CHAMELEON_Complex64_t alpha = testing_zalea(); + int seedA = run_arg_get_int( args, "seedA", random() ); + int seedB = run_arg_get_int( args, "seedB", random() ); + int Q = parameters_compute_q( P ); + cham_fixdbl_t t, gflops; + cham_fixdbl_t flops = flops_ztrsm( side, N, K ); + + alpha = run_arg_get_complex64( args, "alpha", alpha ); + + CHAMELEON_Set( CHAMELEON_TILE_SIZE, nb ); + + /* Calculates the dimensions according to the side */ + if ( side == ChamLeft ) { + Bm = N; + Bn = K; } - - CHAMELEON_Complex64_t alpha = (CHAMELEON_Complex64_t) atol(argv[0]); - int M = atoi(argv[1]); - int N = atoi(argv[2]); - int LDA = atoi(argv[3]); - int LDB = atoi(argv[4]); - - double eps; - int info_solution; - int s, u, t, d, i; - int LDAxM = LDA*max(M,N); - int LDBxN = LDB*max(M,N); - - CHAMELEON_Complex64_t *A = (CHAMELEON_Complex64_t *)malloc(LDAxM*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *B = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Binit = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Bfinal = (CHAMELEON_Complex64_t *)malloc(LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* Check if unable to allocate memory */ - if ( (!A) || (!B) || (!Binit) || (!Bfinal) ) - { - free(A); free(B); - free(Binit); free(Bfinal); - printf("Out of Memory \n "); - return -2; + else { + Bm = K; + Bn = N; } - eps = LAPACKE_dlamch_work('e'); - - printf("\n"); - printf("------ TESTS FOR CHAMELEON ZTRSM ROUTINE ------- \n"); - printf(" Size of the Matrix B : %d by %d\n", M, N); - printf("\n"); - printf(" The matrix A is randomly generated for each test.\n"); - printf("============\n"); - printf(" The relative machine precision (eps) is to be %e \n",eps); - printf(" Computational tests pass if scaled residuals are less than 10.\n"); - - /*---------------------------------------------------------- - * TESTING ZTRSM - */ - - /* Initialize A, B, C */ - LAPACKE_zlarnv_work(IONE, ISEED, LDAxM, A); - LAPACKE_zlarnv_work(IONE, ISEED, LDBxN, B); - for(i=0;i<max(M,N);i++) - A[LDA*i+i] = A[LDA*i+i] + 2.0; - - for (s=0; s<2; s++) { - for (u=0; u<2; u++) { -#if defined(PRECISION_z) || defined(PRECISION_c) - for (t=0; t<3; t++) { -#else - for (t=0; t<2; t++) { -#endif - for (d=0; d<2; d++) { - - memcpy(Binit, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - memcpy(Bfinal, B, LDBxN*sizeof(CHAMELEON_Complex64_t)); - - /* CHAMELEON ZTRSM */ - CHAMELEON_ztrsm(side[s], uplo[u], trans[t], diag[d], - M, N, alpha, A, LDA, Bfinal, LDB); - - /* Check the solution */ - info_solution = check_solution(side[s], uplo[u], trans[t], diag[d], - M, N, alpha, A, LDA, Binit, Bfinal, LDB); - - printf("***************************************************\n"); - if (info_solution == 0) { - printf(" ---- TESTING ZTRSM (%s, %s, %s, %s) ...... PASSED !\n", - sidestr[s], uplostr[u], transstr[t], diagstr[d]); - } - else { - printf(" ---- TESTING ZTRSM (%s, %s, %s, %s) ... FAILED !\n", - sidestr[s], uplostr[u], transstr[t], diagstr[d]); hres++; - } - printf("***************************************************\n"); - } - } - } + /* Creates the matrices */ + CHAMELEON_Desc_Create( + &descA, NULL, ChamComplexDouble, nb, nb, nb * nb, LDA, N, 0, 0, N, N, P, Q ); + CHAMELEON_Desc_Create( + &descB, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); + + /* Fills the matrix with random values */ + /* We bump a little bit the diagonal to make it stable */ + CHAMELEON_zplgsy_Tile( 2., uplo, descA, seedA ); + CHAMELEON_zplrnt_Tile( descB, seedB ); + + /* Calculates the product */ + START_TIMING( t ); + hres = CHAMELEON_ztrsm_Tile( side, uplo, trans, diag, alpha, descA, descB ); + STOP_TIMING( t ); + gflops = flops * 1.e-9 / t; + run_arg_add_fixdbl( args, "time", t ); + run_arg_add_fixdbl( args, "gflops", ( hres == CHAMELEON_SUCCESS ) ? gflops : -1. ); + + /* Checks the solution */ + if ( check ) { + CHAMELEON_Desc_Create( + &descBinit, NULL, ChamComplexDouble, nb, nb, nb * nb, LDB, Bn, 0, 0, Bm, Bn, P, Q ); + CHAMELEON_zplrnt_Tile( descBinit, seedB ); + + hres += check_ztrmm( args, CHECK_TRSM, side, uplo, trans, diag, alpha, descA, descB, descBinit ); + + CHAMELEON_Desc_Destroy( &descBinit ); } - free(A); free(B); - free(Binit); free(Bfinal); + CHAMELEON_Desc_Destroy( &descA ); + CHAMELEON_Desc_Destroy( &descB ); + run_id++; return hres; } -/*-------------------------------------------------------------- - * Check the solution +testing_t test_ztrsm; +const char *ztrsm_params[] = { "nb", "trans", "side", "uplo", "diag", "n", "k", + "lda", "ldb", "alpha", "seedA", "seedB", NULL }; +const char *ztrsm_output[] = { NULL }; +const char *ztrsm_outchk[] = { "RETURN", NULL }; + +/** + * @brief Testing registration function */ -static int check_solution(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int N, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bref, CHAMELEON_Complex64_t *Bcham, int LDB) +void testing_ztrsm_init( void ) __attribute__( ( constructor ) ); +void +testing_ztrsm_init( void ) { - int info_solution; - double Anorm, Binitnorm, Bchamnorm, Blapacknorm, Rnorm, result; - double eps; - CHAMELEON_Complex64_t mzone = (CHAMELEON_Complex64_t)-1.0; - - double *work = (double *)malloc(max(M, N)* sizeof(double)); - int Am, An; - - if (side == ChamLeft) { - Am = M; An = M; - } else { - Am = N; An = N; - } - - Anorm = LAPACKE_zlantr_work(LAPACK_COL_MAJOR, 'I', chameleon_lapack_const(uplo), chameleon_lapack_const(diag), - Am, An, A, LDA, work); - Binitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - Bchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bcham, LDB, work); - - cblas_ztrsm(CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans, - (CBLAS_DIAG)diag, M, N, CBLAS_SADDR(alpha), A, LDA, Bref, LDB); - - Blapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - - cblas_zaxpy(LDB * N, CBLAS_SADDR(mzone), Bcham, 1, Bref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Bref, LDB, work); - - eps = LAPACKE_dlamch_work('e'); - - printf("Rnorm %e, Anorm %e, Binitnorm %e, Bchamnorm %e, Blapacknorm %e\n", - Rnorm, Anorm, Binitnorm, Bchamnorm, Blapacknorm); - - result = Rnorm / ((Anorm + Blapacknorm) * max(M,N) * eps); - - printf("============\n"); - printf("Checking the norm of the difference against reference ZTRSM \n"); - printf("-- ||Ccham - Clapack||_oo/((||A||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isinf(Blapacknorm) || isinf(Bchamnorm) || isnan(result) || isinf(result) || (result > 10.0) ) { - printf("-- The solution is suspicious ! \n"); - info_solution = 1; - } - else { - printf("-- The solution is CORRECT ! \n"); - info_solution= 0 ; - } - free(work); - - return info_solution; + test_ztrsm.name = "ztrsm"; + test_ztrsm.helper = "Triangular matrix solve"; + test_ztrsm.params = ztrsm_params; + test_ztrsm.output = ztrsm_output; + test_ztrsm.outchk = ztrsm_outchk; + test_ztrsm.params_list = "nb;P;trans;side;uplo;diag;n;k;lda;ldb;alpha;seedA;seedB"; + test_ztrsm.fptr = testing_ztrsm; + test_ztrsm.next = NULL; + + testing_register( &test_ztrsm ); } diff --git a/new-testing/testing_ztrtri.c b/testing/testing_ztrtri.c similarity index 93% rename from new-testing/testing_ztrtri.c rename to testing/testing_ztrtri.c index 4eccb1b03f4d66957a6eb6ee3565204347b34e7e..549f33f614676858afdc601922014615aab5e9b3 100644 --- a/new-testing/testing_ztrtri.c +++ b/testing/testing_ztrtri.c @@ -2,21 +2,21 @@ * * @file testing_ztrtri.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon ztrtri testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-08-14 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -85,7 +85,7 @@ void testing_ztrtri_init( void ) { test_ztrtri.name = "ztrtri"; - test_ztrtri.helper = "ztrtri"; + test_ztrtri.helper = "Triangular matrix inversion"; test_ztrtri.params = ztrtri_params; test_ztrtri.output = ztrtri_output; test_ztrtri.outchk = ztrtri_outchk; diff --git a/new-testing/testing_zunglq.c b/testing/testing_zunglq.c similarity index 95% rename from new-testing/testing_zunglq.c rename to testing/testing_zunglq.c index bfd9417c1bd347c8cea03c68dda838b7cef3a4e2..153fb9a95349b6caa635d1e3de46181562b46c07 100644 --- a/new-testing/testing_zunglq.c +++ b/testing/testing_zunglq.c @@ -2,21 +2,21 @@ * * @file testing_zunglq.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunglq testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -104,7 +104,7 @@ void testing_zunglq_init( void ) { test_zunglq.name = "zunglq"; - test_zunglq.helper = "zunglq"; + test_zunglq.helper = "Q generation (LQ)"; test_zunglq.params = zunglq_params; test_zunglq.output = zunglq_output; test_zunglq.outchk = zunglq_outchk; diff --git a/new-testing/testing_zunglq_hqr.c b/testing/testing_zunglq_hqr.c similarity index 95% rename from new-testing/testing_zunglq_hqr.c rename to testing/testing_zunglq_hqr.c index f9e1406d59d1ca31f5e4603cd0a95e0ffb7fc717..d0349fbd22322d0ba11cb997a771bb3a7b099955 100644 --- a/new-testing/testing_zunglq_hqr.c +++ b/testing/testing_zunglq_hqr.c @@ -2,21 +2,21 @@ * * @file testing_zunglq_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunglq_hqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -115,7 +115,7 @@ void testing_zunglq_hqr_init( void ) { test_zunglq_hqr.name = "zunglq_hqr"; - test_zunglq_hqr.helper = "zunglq_hqr"; + test_zunglq_hqr.helper = "Q generation with hierarchical reduction trees (LQ)"; test_zunglq_hqr.params = zunglq_hqr_params; test_zunglq_hqr.output = zunglq_hqr_output; test_zunglq_hqr.outchk = zunglq_hqr_outchk; diff --git a/new-testing/testing_zungqr.c b/testing/testing_zungqr.c similarity index 95% rename from new-testing/testing_zungqr.c rename to testing/testing_zungqr.c index 51097db05971556dc0e6d3274f212ac300cbc351..934fa05d5378e78e48bce74b4cfbcb234e824329 100644 --- a/new-testing/testing_zungqr.c +++ b/testing/testing_zungqr.c @@ -2,21 +2,21 @@ * * @file testing_zungqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zungqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -104,7 +104,7 @@ void testing_zungqr_init( void ) { test_zungqr.name = "zungqr"; - test_zungqr.helper = "zungqr"; + test_zungqr.helper = "Q generation (QR)"; test_zungqr.params = zungqr_params; test_zungqr.output = zungqr_output; test_zungqr.outchk = zungqr_outchk; diff --git a/new-testing/testing_zungqr_hqr.c b/testing/testing_zungqr_hqr.c similarity index 95% rename from new-testing/testing_zungqr_hqr.c rename to testing/testing_zungqr_hqr.c index e31c224cb8122dfaa45329816013a3fcefc664da..364a3cf6306c9533916339523a14ae9c0a830a52 100644 --- a/new-testing/testing_zungqr_hqr.c +++ b/testing/testing_zungqr_hqr.c @@ -2,21 +2,21 @@ * * @file testing_zungqr_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zungqr_hqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-09-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -115,7 +115,7 @@ void testing_zungqr_hqr_init( void ) { test_zungqr_hqr.name = "zungqr_hqr"; - test_zungqr_hqr.helper = "zungqr_hqr"; + test_zungqr_hqr.helper = "Q generation with hierarchical reduction trees (QR)"; test_zungqr_hqr.params = zungqr_hqr_params; test_zungqr_hqr.output = zungqr_hqr_output; test_zungqr_hqr.outchk = zungqr_hqr_outchk; diff --git a/new-testing/testing_zunmlq.c b/testing/testing_zunmlq.c similarity index 96% rename from new-testing/testing_zunmlq.c rename to testing/testing_zunmlq.c index ef8fcbeeb6b6b65ca46f846f9f1ae1a017479f6a..dd6db201e7cce62756b04fbd2ab2ff72158c8dac 100644 --- a/new-testing/testing_zunmlq.c +++ b/testing/testing_zunmlq.c @@ -2,22 +2,22 @@ * * @file testing_zunmlq.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-11-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -123,7 +123,7 @@ void testing_zunmlq_init( void ) { test_zunmlq.name = "zunmlq"; - test_zunmlq.helper = "zunmlq"; + test_zunmlq.helper = "Q application (LQ)"; test_zunmlq.params = zunmlq_params; test_zunmlq.output = zunmlq_output; test_zunmlq.outchk = zunmlq_outchk; diff --git a/new-testing/testing_zunmlq_hqr.c b/testing/testing_zunmlq_hqr.c similarity index 95% rename from new-testing/testing_zunmlq_hqr.c rename to testing/testing_zunmlq_hqr.c index 2c6dac1a33ae43478eb5f9b03a2485068a9562a7..eb683f73e666e08aabc01997bbd8b030f8710e16 100644 --- a/new-testing/testing_zunmlq_hqr.c +++ b/testing/testing_zunmlq_hqr.c @@ -2,22 +2,22 @@ * * @file testing_zunmlq_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmlq_hqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-11-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -134,7 +134,7 @@ void testing_zunmlq_hqr_init( void ) { test_zunmlq_hqr.name = "zunmlq_hqr"; - test_zunmlq_hqr.helper = "zunmlq_hqr"; + test_zunmlq_hqr.helper = "Q application with hierarchical reduction trees (LQ)"; test_zunmlq_hqr.params = zunmlq_hqr_params; test_zunmlq_hqr.output = zunmlq_hqr_output; test_zunmlq_hqr.outchk = zunmlq_hqr_outchk; diff --git a/new-testing/testing_zunmqr.c b/testing/testing_zunmqr.c similarity index 96% rename from new-testing/testing_zunmqr.c rename to testing/testing_zunmqr.c index 88635dd909fc6704f10360d8cf3fa816a912f9b0..7059dbb7ef3b84bf65ad9f5655434c84177bd141 100644 --- a/new-testing/testing_zunmqr.c +++ b/testing/testing_zunmqr.c @@ -2,22 +2,22 @@ * * @file testing_zunmqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-11-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -123,7 +123,7 @@ void testing_zunmqr_init( void ) { test_zunmqr.name = "zunmqr"; - test_zunmqr.helper = "zunmqr"; + test_zunmqr.helper = "Q application (QR)"; test_zunmqr.params = zunmqr_params; test_zunmqr.output = zunmqr_output; test_zunmqr.outchk = zunmqr_outchk; diff --git a/new-testing/testing_zunmqr_hqr.c b/testing/testing_zunmqr_hqr.c similarity index 96% rename from new-testing/testing_zunmqr_hqr.c rename to testing/testing_zunmqr_hqr.c index cf56de1a950af83e68591b9964c5372e5472574e..10a204f4c6b1213c80dc02a92e44aadab10e3ac3 100644 --- a/new-testing/testing_zunmqr_hqr.c +++ b/testing/testing_zunmqr_hqr.c @@ -2,22 +2,22 @@ * * @file testing_zunmqr_hqr.c * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. * *** * * @brief Chameleon zunmqr_hqr testing * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-11-09 + * @date 2020-03-03 * @precisions normal z -> c d s * */ #include <chameleon.h> #include <assert.h> -#include "testing_zauxiliary.h" +#include "testings.h" #include "testing_zcheck.h" #include "flops.h" @@ -134,7 +134,7 @@ void testing_zunmqr_hqr_init( void ) { test_zunmqr_hqr.name = "zunmqr_hqr"; - test_zunmqr_hqr.helper = "zunmqr_hqr"; + test_zunmqr_hqr.helper = "Q application with hierarchical reduction trees (QR)"; test_zunmqr_hqr.params = zunmqr_hqr_params; test_zunmqr_hqr.output = zunmqr_hqr_output; test_zunmqr_hqr.outchk = zunmqr_hqr_outchk; diff --git a/new-testing/testings.h b/testing/testings.h similarity index 91% rename from new-testing/testings.h rename to testing/testings.h index 8b7a7298e1be21438ba363a3c48f6431055ccfc6..8f68b5fce5efe3a14950c66188e119f2a1206857 100644 --- a/new-testing/testings.h +++ b/testing/testings.h @@ -2,15 +2,15 @@ * * @file testings.h * - * @copyright 2019-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, + * @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, * Univ. Bordeaux. All rights reserved. *** * * @brief Chameleon auxiliary routines for testing structures * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis - * @date 2019-07-18 + * @date 2020-03-03 * */ #ifndef _testings_h_ @@ -217,4 +217,26 @@ void run_list_destroy( run_list_elt_t *run ); void testing_register( testing_t *test ); +/** + * @brief Macros to enable distributed synchronization if necessary + */ +#if defined(CHAMELEON_USE_MPI) +#define START_DISTRIBUTED() CHAMELEON_Distributed_start(); +#define STOP_DISTRIBUTED() CHAMELEON_Distributed_stop(); +#else +#define START_DISTRIBUTED() do {} while(0); +#define STOP_DISTRIBUTED() do {} while(0); +#endif + +/** + * @brief Macros to start/stop timers with necessary synchronizations + */ +#define START_TIMING( _t_ ) \ + START_DISTRIBUTED(); \ + (_t_) = RUNTIME_get_time(); + +#define STOP_TIMING( _t_ ) \ + STOP_DISTRIBUTED(); \ + (_t_) = RUNTIME_get_time() - (_t_); \ + #endif /* _testings_h_ */ diff --git a/new-testing/values.c b/testing/values.c similarity index 99% rename from new-testing/values.c rename to testing/values.c index 28f59bff5ae902ed5eccfaffe7fcd4882c88e7f4..e7dda51834f08c17d637d6eabbb4aa0c76d531df 100644 --- a/new-testing/values.c +++ b/testing/values.c @@ -8,10 +8,10 @@ * * @brief Chameleon testing values toutine to read/print the parameters * - * @version 0.9.2 + * @version 1.0.0 * @author Lucas Barros de Assis * @author Mathieu Faverge - * @date 2019-07-18 + * @date 2020-03-03 * */ #include "testings.h" diff --git a/timing/CMakeLists.txt b/timing/CMakeLists.txt deleted file mode 100644 index e27c58a9277f6340aa4ecfb3347d2520298efb91..0000000000000000000000000000000000000000 --- a/timing/CMakeLists.txt +++ /dev/null @@ -1,194 +0,0 @@ -### -# -# @file CMakeLists.txt -# -# @copyright 2009-2014 The University of Tennessee and The University of -# Tennessee Research Foundation. All rights reserved. -# @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, -# Univ. Bordeaux. All rights reserved. -# -### -# -# @project CHAMELEON -# CHAMELEON is a software package provided by: -# Inria Bordeaux - Sud-Ouest, -# Univ. of Tennessee, -# King Abdullah Univesity of Science and Technology -# Univ. of California Berkeley, -# Univ. of Colorado Denver. -# -# @version 0.9.2 -# @author Cedric Castagnede -# @author Emmanuel Agullo -# @author Mathieu Faverge -# @date 2014-11-16 -# -### - -# Generate the chameleon auxiliary headers for all possible precisions -# ---------------------------------------------------------------- -set(TIMING_AUX_HDRS_GENERATED "") -set(ZHDR - timing_zauxiliary.h - ) - -precisions_rules_py(TIMING_AUX_HDRS_GENERATED "${ZHDR}" - PRECISIONS "s;d;c;z;ds;zc" ) - -set(TIMING_AUX_HDRS - timing.h - timing.c - ${TIMING_AUX_HDRS_GENERATED} - ) - -# Force generation of headers -# --------------------------- -add_custom_target(timing_include ALL SOURCES ${TIMING_AUX_HDRS}) -set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};timing_include" CACHE INTERNAL "List of targets of sources") - -if (NOT CHAMELEON_SIMULATION) - # Generate the chameleon auxiliary sources for all possible precisions - # ---------------------------------------------------------------- - set(TIMING_AUX_SRCS_GENERATED "") - set(ZSRC - timing_zauxiliary.c - ) - - precisions_rules_py(TIMING_AUX_SRCS_GENERATED "${ZSRC}" - PRECISIONS "${CHAMELEON_PRECISION}") - - set(TIMING_SRCS ${TIMING_AUX_SRCS_GENERATED}) - # Force generation of sources - # --------------------------- - add_custom_target(timing_aux_sources ALL SOURCES ${TIMINGS_SRCS}) - set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};timing_aux_sources" CACHE INTERNAL "List of targets of sources") - - # Create libchameleon_timing.a - # ----------------------------- - add_library(chameleon_timing STATIC ${TIMING_SRCS}) - set_property(TARGET chameleon_timing PROPERTY LINKER_LANGUAGE Fortran) - add_dependencies(chameleon_timing timing_include timing_aux_sources chameleon_include) -endif() - -# Generate the chameleon testing sources for all possible precisions -# -------------------------------------------------------------- -set(TIMINGS "") -set(ZSRC_LAP_INT - # BLAS 3 - time_zgemm.c - time_ztrsm.c - # LAPACK - time_zgels.c - time_zgeqrf.c - time_zgeqrf_hqr.c - time_zgelqf.c - time_zgetrf_incpiv.c - time_zgetrf_nopiv.c - #time_zgetrf.c - time_zposv.c - time_zpotrf.c - # MIXED PRECISION - #time_zcgesv.c - #time_zcposv.c - # OTHERS - time_zlange.c - #time_zgecfi.c - #time_zgetrf_reclap.c - #time_zgetrf_rectil.c - #time_zgesv.c - time_zgesv_incpiv.c - time_zgesv_nopiv.c - ) - -set(ZSRC_TIL_INT - # BLAS 3 - time_zgemm_tile.c - time_zhemm_tile.c - time_zsymm_tile.c - # LAPACK - time_zgels_tile.c - time_zgeqrf_hqr_tile.c - time_zgeqrf_tile.c - time_zgelqf_tile.c - time_zgeqrs_tile.c - time_zgetrf_incpiv_tile.c - time_zgetrf_nopiv_tile.c - time_zgetrs_incpiv_tile.c - time_zgetrs_nopiv_tile.c - #time_zgetrf_tile.c - time_zposv_tile.c - time_zpotrf_tile.c - time_zpotrs_tile.c - time_zsytrf_tile.c - time_zpotri_tile.c - # MIXED PRECISION - #time_zcgesv_tile.c - #time_zcposv_tile.c - # OTHERS - time_zlange_tile.c - #time_zgebrd_tile.c - #time_zgesvd_tile.c - #time_zheevd_tile.c - #time_zheev_tile.c - #time_zhegv_tile.c - #time_zlapack2tile.c - #time_zgetri_tile.c - #time_zgesv_tile.c - time_zgesv_incpiv_tile.c - time_zgesv_nopiv_tile.c - ) - -if (NOT CHAMELEON_SIMULATION) - set(ZSRC - ${ZSRC_LAP_INT} - ${ZSRC_TIL_INT} - time_zgesvd_tile.c - time_zheevd_tile.c - ) -else(NOT CHAMELEON_SIMULATION) - set(ZSRC - ${ZSRC_TIL_INT} - ) -endif(NOT CHAMELEON_SIMULATION) - -precisions_rules_py(TIMINGS "${ZSRC}" - PRECISIONS "${CHAMELEON_PRECISION}") - -# Force generation of sources -# --------------------------- -add_custom_target(timing_sources ALL SOURCES ${TIMINGS}) -set(CHAMELEON_SOURCES_TARGETS "${CHAMELEON_SOURCES_TARGETS};timing_sources" CACHE INTERNAL "List of targets of sources") - -# Add include and link directories -# -------------------------------- -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) -include_directories(${CMAKE_CURRENT_BINARY_DIR}) -link_directories(${CMAKE_CURRENT_BINARY_DIR}) - -# Define what libraries we have to link with -# ------------------------------------------ -set(libs_for_timings) -if(NOT CHAMELEON_SIMULATION) - list(APPEND libs_for_timings chameleon_timing) -endif() - -# timing executables depend on chameleon and cblas, lapacke, starpu (optional), mpi (already chameleon's dependencies) -list(APPEND libs_for_timings chameleon) -# message(STATUS "libs timings: ${libs_for_timings}") - -foreach(_timing ${TIMINGS}) - get_filename_component(_name_exe ${_timing} NAME_WE) - add_executable(${_name_exe} ${_timing}) - add_dependencies(${_name_exe} timing_include) - set_property(TARGET ${_name_exe} PROPERTY LINKER_LANGUAGE Fortran) - target_link_libraries(${_name_exe} ${libs_for_timings}) - install(TARGETS ${_name_exe} - DESTINATION bin/timing) -endforeach() - -#-------- Tests --------- -#include(CTestLists.cmake) - -### -### END CMakeLists.txt -### diff --git a/timing/CTestLists.cmake b/timing/CTestLists.cmake deleted file mode 100644 index 9785a19b36b32d6f5447856190a9c94ae5fc3c05..0000000000000000000000000000000000000000 --- a/timing/CTestLists.cmake +++ /dev/null @@ -1,131 +0,0 @@ -# -# Check timing/ -# - -set(TEST_CMD_shm --n_range=17:407:39 --nb=32 --ib=7 ) -set(TEST_CMD_shmgpu --n_range=170:4070:390 --nb=320 --ib=48 --gpus=1 ) -set(TEST_CMD_mpi --n_range=17:407:39 --nb=32 --ib=7 --P=2 ) -set(TEST_CMD_mpigpu --n_range=170:4070:390 --nb=320 --ib=48 --P=2 --gpus=1) - -set(MPI_CMD_shm ) -set(MPI_CMD_shmgpu ) -set(MPI_CMD_mpi mpirun -np 4) -set(MPI_CMD_mpigpu mpirun -np 4) - -if (NOT CHAMELEON_SIMULATION) - set( TEST_CATEGORIES shm ) - if (CHAMELEON_USE_CUDA AND CUDA_FOUND) - set( TEST_CATEGORIES ${TEST_CATEGORIES} shmgpu ) - endif() -else() - set( TEST_CATEGORIES simushm ) - if (CHAMELEON_USE_CUDA AND CUDA_FOUND) - set( TEST_CATEGORIES ${TEST_CATEGORIES} simugpu ) - endif() -endif() - -set(TESTLIST - gels - gemm - getrf_incpiv - getrf_nopiv - geqrf - gelqf - posv - potrf - potri - ) - -set(CHAMELEON_PRECISIONS_ZC "c;z") -set(TESTLIST_ZC - sytrf - ) - -if (NOT CHAMELEON_SIMULATION) - - foreach(cat ${TEST_CATEGORIES}) - foreach(prec ${RP_CHAMELEON_PRECISIONS}) - string(TOUPPER ${prec} PREC) - if (CHAMELEON_PREC_${PREC}) - foreach(test ${TESTLIST}) - add_test(time_${cat}_${prec}${test} ${MPI_CMD_${cat}} ./time_${prec}${test}_tile ${TEST_CMD_${cat}} --check) - endforeach() - endif() - endforeach() - foreach(prec ${CHAMELEON_PRECISIONS_ZC}) - string(TOUPPER ${prec} PREC) - if (CHAMELEON_PREC_${PREC}) - foreach(test ${TESTLIST_ZC}) - add_test(time_${cat}_${prec}${test} ${MPI_CMD_${cat}} ./time_${prec}${test}_tile ${TEST_CMD_${cat}} --check) - endforeach() - endif() - endforeach() - endforeach() - - # if ( CHAMELEON_SCHED_STARPU ) - # foreach(cat ${TEST_CATEGORIES}) - # foreach(prec ${RP_CHAMELEON_PRECISIONS}) - # string(TOUPPER ${prec} PREC) - # if (CHAMELEON_PREC_${PREC}) - # foreach(test ${TESTLIST}) - # add_test(time_ooc_${cat}_${prec}${test} ${MPI_CMD_${cat}} ./time_${prec}${test}_tile ${TEST_CMD_${cat}} --ooc --check) - # set_tests_properties(time_ooc_${cat}_${prec}${test} PROPERTIES - # ENVIRONMENT "STARPU_DISK_SWAP=/tmp;STARPU_LIMIT_CPU_MEM=1" - # ) - # endforeach() - # endif() - # endforeach() - # foreach(prec ${CHAMELEON_PRECISIONS_ZC}) - # string(TOUPPER ${prec} PREC) - # if (CHAMELEON_PREC_${PREC}) - # foreach(test ${TESTLIST_ZC}) - # add_test(time_ooc_${cat}_${prec}${test} ${MPI_CMD_${cat}} ./time_${prec}${test}_tile ${TEST_CMD_${cat}} --ooc --check) - # set_tests_properties(time_ooc_${cat}_${prec}${test} PROPERTIES - # ENVIRONMENT "STARPU_DISK_SWAP=/tmp;STARPU_LIMIT_CPU_MEM=1" - # ) - # endforeach() - # endif() - # endforeach() - # endforeach() - # endif() - - if (CHAMELEON_USE_MPI AND MPI_C_FOUND) - set( TEST_CATEGORIES mpi ) - #set( TEST_CATEGORIES ${TEST_CATEGORIES} mpi ) - #if (CHAMELEON_USE_CUDA AND CUDA_FOUND) - # set( TEST_CATEGORIES ${TEST_CATEGORIES} mpigpu ) - #endif() - set(TESTLIST_MPI - potrf - ) - foreach(cat ${TEST_CATEGORIES}) - foreach(prec ${RP_CHAMELEON_PRECISIONS}) - string(TOUPPER ${prec} PREC) - - if (CHAMELEON_PREC_${PREC}) - foreach(test ${TESTLIST_MPI}) - add_test(time_${cat}_${prec}${test} ${MPI_CMD_${cat}} ./time_${prec}${test}_tile ${TEST_CMD_${cat}} --check) - endforeach() - endif() - endforeach() - endforeach() - endif() - -else (NOT CHAMELEON_SIMULATION) - - set(TEST_CMD_simushm -N 9600:9600:1 -b 960) - set(TEST_CMD_simugpu -N 9600:9600:1 -b 960 -g 1) - set(RP_CHAMELEON_PRECISIONS_SIMU "s;d") - foreach(cat ${TEST_CATEGORIES}) - foreach(prec ${RP_CHAMELEON_PRECISIONS_SIMU}) - string(TOUPPER ${prec} PREC) - if (CHAMELEON_PREC_${PREC}) - add_test(time_${cat}_${prec}potrf ${MPI_CMD_${cat}} ./time_${prec}potrf_tile ${TEST_CMD_${cat}}) - set_tests_properties(time_${cat}_${prec}potrf PROPERTIES - ENVIRONMENT "STARPU_HOME=${CMAKE_SOURCE_DIR}/simucore/perfmodels;STARPU_HOSTNAME=sirocco" - ) - endif() - endforeach() - endforeach() - -endif (NOT CHAMELEON_SIMULATION) diff --git a/timing/flops.h b/timing/flops.h deleted file mode 100644 index 13c62cedb2b3b214c8b7a0a1ed75604ef737bed7..0000000000000000000000000000000000000000 --- a/timing/flops.h +++ /dev/null @@ -1,358 +0,0 @@ -/** - * - * @file flops.h - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * File provided by Univ. of Tennessee, - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Cedric Castagnede - * @date 2014-11-16 - * - */ -/* - * This file provide the flops formula for all Level 3 BLAS and some - * Lapack routines. Each macro uses the same size parameters as the - * function associated and provide one formula for additions and one - * for multiplications. Example to use these macros: - * - * FLOPS_ZGEMM( m, n, k ) - * - * All the formula are reported in the LAPACK Lawn 41: - * http://www.netlib.org/lapack/lawns/lawn41.ps - */ -#ifndef _flops_h_ -#define _flops_h_ - -/** - * Generic formula coming from LAWN 41 - */ - -/* - * Level 2 BLAS - */ -#define FMULS_GEMV(__m, __n) ((double)(__m) * (double)(__n) + 2. * (double)(__m)) -#define FADDS_GEMV(__m, __n) ((double)(__m) * (double)(__n) ) - -#define FMULS_SYMV(__n) FMULS_GEMV( (__n), (__n) ) -#define FADDS_SYMV(__n) FADDS_GEMV( (__n), (__n) ) -#define FMULS_HEMV FMULS_SYMV -#define FADDS_HEMV FADDS_SYMV - -/* - * Level 3 BLAS - */ -#define FMULS_GEMM(__m, __n, __k) ((double)(__m) * (double)(__n) * (double)(__k)) -#define FADDS_GEMM(__m, __n, __k) ((double)(__m) * (double)(__n) * (double)(__k)) - -#define FMULS_SYMM(__side, __m, __n) ( ( (__side) == ChamLeft ) ? FMULS_GEMM((__m), (__m), (__n)) : FMULS_GEMM((__m), (__n), (__n)) ) -#define FADDS_SYMM(__side, __m, __n) ( ( (__side) == ChamLeft ) ? FADDS_GEMM((__m), (__m), (__n)) : FADDS_GEMM((__m), (__n), (__n)) ) -#define FMULS_HEMM FMULS_SYMM -#define FADDS_HEMM FADDS_SYMM - -#define FMULS_SYRK(__k, __n) (0.5 * (double)(__k) * (double)(__n) * ((double)(__n)+1.)) -#define FADDS_SYRK(__k, __n) (0.5 * (double)(__k) * (double)(__n) * ((double)(__n)+1.)) -#define FMULS_HERK FMULS_SYRK -#define FADDS_HERK FADDS_SYRK - -#define FMULS_SYR2K(__k, __n) ((double)(__k) * (double)(__n) * (double)(__n) ) -#define FADDS_SYR2K(__k, __n) ((double)(__k) * (double)(__n) * (double)(__n) + (double)(__n)) -#define FMULS_HER2K FMULS_SYR2K -#define FADDS_HER2K FADDS_SYR2K - -#define FMULS_TRMM_2(__m, __n) (0.5 * (double)(__n) * (double)(__m) * ((double)(__m)+1.)) -#define FADDS_TRMM_2(__m, __n) (0.5 * (double)(__n) * (double)(__m) * ((double)(__m)-1.)) - - -#define FMULS_TRMM(__side, __m, __n) ( ( (__side) == ChamLeft ) ? FMULS_TRMM_2((__m), (__n)) : FMULS_TRMM_2((__n), (__m)) ) -#define FADDS_TRMM(__side, __m, __n) ( ( (__side) == ChamLeft ) ? FADDS_TRMM_2((__m), (__n)) : FADDS_TRMM_2((__n), (__m)) ) - -#define FMULS_TRSM FMULS_TRMM -#define FADDS_TRSM FMULS_TRMM - -/* - * Lapack - */ -#define FMULS_GETRF(__m, __n) ( ((__m) < (__n)) ? (0.5 * (double)(__m) * ((double)(__m) * ((double)(__n) - (1./3.) * (__m) - 1. ) + (double)(__n)) + (2. / 3.) * (__m)) \ - : (0.5 * (double)(__n) * ((double)(__n) * ((double)(__m) - (1./3.) * (__n) - 1. ) + (double)(__m)) + (2. / 3.) * (__n)) ) -#define FADDS_GETRF(__m, __n) ( ((__m) < (__n)) ? (0.5 * (double)(__m) * ((double)(__m) * ((double)(__n) - (1./3.) * (__m) ) - (double)(__n)) + (1. / 6.) * (__m)) \ - : (0.5 * (double)(__n) * ((double)(__n) * ((double)(__m) - (1./3.) * (__n) ) - (double)(__m)) + (1. / 6.) * (__n)) ) - -#define FMULS_GETRI(__n) ( (double)(__n) * ((5. / 6.) + (double)(__n) * ((2. / 3.) * (double)(__n) + 0.5)) ) -#define FADDS_GETRI(__n) ( (double)(__n) * ((5. / 6.) + (double)(__n) * ((2. / 3.) * (double)(__n) - 1.5)) ) - -#define FMULS_GETRS(__n, __nrhs) ((double)(__nrhs) * (double)(__n) * (double)(__n) ) -#define FADDS_GETRS(__n, __nrhs) ((double)(__nrhs) * (double)(__n) * ((double)(__n) - 1. )) - -#define FMULS_POTRF(__n) ((double)(__n) * (((1. / 6.) * (double)(__n) + 0.5) * (double)(__n) + (1. / 3.))) -#define FADDS_POTRF(__n) ((double)(__n) * (((1. / 6.) * (double)(__n) ) * (double)(__n) - (1. / 6.))) - -#define FMULS_POTRI(__n) ( (double)(__n) * ((2. / 3.) + (double)(__n) * ((1. / 3.) * (double)(__n) + 1. )) ) -#define FADDS_POTRI(__n) ( (double)(__n) * ((1. / 6.) + (double)(__n) * ((1. / 3.) * (double)(__n) - 0.5)) ) - -#define FMULS_POTRS(__n, __nrhs) ((double)(__nrhs) * (double)(__n) * ((double)(__n) + 1. )) -#define FADDS_POTRS(__n, __nrhs) ((double)(__nrhs) * (double)(__n) * ((double)(__n) - 1. )) - -//SPBTRF -//SPBTRS - -#define FMULS_SYTRF(__n) ((double)(__n) * (((1. / 6.) * (double)(__n) + 0.5) * (double)(__n) + (1. / 3.))) -#define FADDS_SYTRF(__n) ((double)(__n) * (((1. / 6.) * (double)(__n) ) * (double)(__n) - (1. / 6.))) - -//SSYTRI -//SSYTRS - -#define FMULS_GEQRF(__m, __n) (((__m) > (__n)) ? ((double)(__n) * ((double)(__n) * ( 0.5-(1./3.) * (double)(__n) + (double)(__m)) + (double)(__m) + 23. / 6.)) \ - : ((double)(__m) * ((double)(__m) * ( -0.5-(1./3.) * (double)(__m) + (double)(__n)) + 2.*(double)(__n) + 23. / 6.)) ) -#define FADDS_GEQRF(__m, __n) (((__m) > (__n)) ? ((double)(__n) * ((double)(__n) * ( 0.5-(1./3.) * (double)(__n) + (double)(__m)) + 5. / 6.)) \ - : ((double)(__m) * ((double)(__m) * ( -0.5-(1./3.) * (double)(__m) + (double)(__n)) + (double)(__n) + 5. / 6.)) ) - -#define FMULS_GEQLF(__m, __n) FMULS_GEQRF(__m, __n) -#define FADDS_GEQLF(__m, __n) FADDS_GEQRF(__m, __n) - -#define FMULS_GERQF(__m, __n) (((__m) > (__n)) ? ((double)(__n) * ((double)(__n) * ( 0.5-(1./3.) * (double)(__n) + (double)(__m)) + (double)(__m) + 29. / 6.)) \ - : ((double)(__m) * ((double)(__m) * ( -0.5-(1./3.) * (double)(__m) + (double)(__n)) + 2.*(double)(__n) + 29. / 6.)) ) -#define FADDS_GERQF(__m, __n) (((__m) > (__n)) ? ((double)(__n) * ((double)(__n) * ( -0.5-(1./3.) * (double)(__n) + (double)(__m)) + (double)(__m) + 5. / 6.)) \ - : ((double)(__m) * ((double)(__m) * ( 0.5-(1./3.) * (double)(__m) + (double)(__n)) + + 5. / 6.)) ) - -#define FMULS_GELQF(__m, __n) FMULS_GERQF(__m, __n) -#define FADDS_GELQF(__m, __n) FADDS_GERQF(__m, __n) - -#define FMULS_UNGQR(__m, __n, __k) ((double)(__k) * (2.* (double)(__m) * (double)(__n) + 2. * (double)(__n) - 5./3. + (double)(__k) * ( 2./3. * (double)(__k) - ((double)(__m) + (double)(__n)) - 1.))) -#define FADDS_UNGQR(__m, __n, __k) ((double)(__k) * (2.* (double)(__m) * (double)(__n) + (double)(__n) - (double)(__m) + 1./3. + (double)(__k) * ( 2./3. * (double)(__k) - ((double)(__m) + (double)(__n)) ))) -#define FMULS_UNGQL FMULS_UNGQR -#define FMULS_ORGQR FMULS_UNGQR -#define FMULS_ORGQL FMULS_UNGQR -#define FADDS_UNGQL FADDS_UNGQR -#define FADDS_ORGQR FADDS_UNGQR -#define FADDS_ORGQL FADDS_UNGQR - -#define FMULS_UNGRQ(__m, __n, __k) ((double)(__k) * (2.* (double)(__m) * (double)(__n) + (double)(__m) + (double)(__n) - 2./3. + (double)(__k) * ( 2./3. * (double)(__k) - ((double)(__m) + (double)(__n)) - 1.))) -#define FADDS_UNGRQ(__m, __n, __k) ((double)(__k) * (2.* (double)(__m) * (double)(__n) + (double)(__m) - (double)(__n) + 1./3. + (double)(__k) * ( 2./3. * (double)(__k) - ((double)(__m) + (double)(__n)) ))) -#define FMULS_UNGLQ FMULS_UNGRQ -#define FMULS_ORGRQ FMULS_UNGRQ -#define FMULS_ORGLQ FMULS_UNGRQ -#define FADDS_UNGLQ FADDS_UNGRQ -#define FADDS_ORGRQ FADDS_UNGRQ -#define FADDS_ORGLQ FADDS_UNGRQ - -#define FMULS_GEQRS(__m, __n, __nrhs) ((double)(__nrhs) * ((double)(__n) * ( 2.* (double)(__m) - 0.5 * (double)(__n) + 2.5))) -#define FADDS_GEQRS(__m, __n, __nrhs) ((double)(__nrhs) * ((double)(__n) * ( 2.* (double)(__m) - 0.5 * (double)(__n) + 0.5))) - -//UNMQR, UNMLQ, UNMQL, UNMRQ (Left) -//UNMQR, UNMLQ, UNMQL, UNMRQ (Right) - -#define FMULS_TRTRI(__n) ((double)(__n) * ((double)(__n) * ( 1./6. * (double)(__n) + 0.5 ) + 1./3.)) -#define FADDS_TRTRI(__n) ((double)(__n) * ((double)(__n) * ( 1./6. * (double)(__n) - 0.5 ) + 1./3.)) - -#define FMULS_GEHRD(__n) ( (double)(__n) * ((double)(__n) * (5./3. *(double)(__n) + 0.5) - 7./6.) - 13. ) -#define FADDS_GEHRD(__n) ( (double)(__n) * ((double)(__n) * (5./3. *(double)(__n) - 1. ) - 2./3.) - 8. ) - -#define FMULS_SYTRD(__n) ( (double)(__n) * ( (double)(__n) * ( 2./3. * (double)(__n) + 2.5 ) - 1./6. ) - 15.) -#define FADDS_SYTRD(__n) ( (double)(__n) * ( (double)(__n) * ( 2./3. * (double)(__n) + 1. ) - 8./3. ) - 4.) -#define FMULS_HETRD FMULS_SYTRD -#define FADDS_HETRD FADDS_SYTRD - -#define FMULS_GEBRD(__m, __n) ( ((__m) >= (__n)) ? ((double)(__n) * ((double)(__n) * (2. * (double)(__m) - 2./3. * (double)(__n) + 2. ) + 20./3.)) \ - : ((double)(__m) * ((double)(__m) * (2. * (double)(__n) - 2./3. * (double)(__m) + 2. ) + 20./3.)) ) -#define FADDS_GEBRD(__m, __n) ( ((__m) >= (__n)) ? ((double)(__n) * ((double)(__n) * (2. * (double)(__m) - 2./3. * (double)(__n) + 1. ) - (double)(__m) + 5./3.)) \ - : ((double)(__m) * ((double)(__m) * (2. * (double)(__n) - 2./3. * (double)(__m) + 1. ) - (double)(__n) + 5./3.)) ) - - -/** - * Users functions - */ - -/* - * Level 2 BLAS - */ -#define FLOPS_ZGEMV(__m, __n) (6. * FMULS_GEMV((__m), (__n)) + 2.0 * FADDS_GEMV((__m), (__n)) ) -#define FLOPS_CGEMV(__m, __n) (6. * FMULS_GEMV((__m), (__n)) + 2.0 * FADDS_GEMV((__m), (__n)) ) -#define FLOPS_DGEMV(__m, __n) ( FMULS_GEMV((__m), (__n)) + FADDS_GEMV((__m), (__n)) ) -#define FLOPS_SGEMV(__m, __n) ( FMULS_GEMV((__m), (__n)) + FADDS_GEMV((__m), (__n)) ) - -#define FLOPS_ZHEMV(__n) (6. * FMULS_HEMV((__n)) + 2.0 * FADDS_HEMV((__n)) ) -#define FLOPS_CHEMV(__n) (6. * FMULS_HEMV((__n)) + 2.0 * FADDS_HEMV((__n)) ) - -#define FLOPS_ZSYMV(__n) (6. * FMULS_SYMV((__n)) + 2.0 * FADDS_SYMV((__n)) ) -#define FLOPS_CSYMV(__n) (6. * FMULS_SYMV((__n)) + 2.0 * FADDS_SYMV((__n)) ) -#define FLOPS_DSYMV(__n) ( FMULS_SYMV((__n)) + FADDS_SYMV((__n)) ) -#define FLOPS_SSYMV(__n) ( FMULS_SYMV((__n)) + FADDS_SYMV((__n)) ) - -/* - * Level 3 BLAS - */ -#define FLOPS_ZGEMM(__m, __n, __k) (6. * FMULS_GEMM((__m), (__n), (__k)) + 2.0 * FADDS_GEMM((__m), (__n), (__k)) ) -#define FLOPS_CGEMM(__m, __n, __k) (6. * FMULS_GEMM((__m), (__n), (__k)) + 2.0 * FADDS_GEMM((__m), (__n), (__k)) ) -#define FLOPS_DGEMM(__m, __n, __k) ( FMULS_GEMM((__m), (__n), (__k)) + FADDS_GEMM((__m), (__n), (__k)) ) -#define FLOPS_SGEMM(__m, __n, __k) ( FMULS_GEMM((__m), (__n), (__k)) + FADDS_GEMM((__m), (__n), (__k)) ) - -#define FLOPS_ZHEMM(__side, __m, __n) (6. * FMULS_HEMM(__side, (__m), (__n)) + 2.0 * FADDS_HEMM(__side, (__m), (__n)) ) -#define FLOPS_CHEMM(__side, __m, __n) (6. * FMULS_HEMM(__side, (__m), (__n)) + 2.0 * FADDS_HEMM(__side, (__m), (__n)) ) - -#define FLOPS_ZSYMM(__side, __m, __n) (6. * FMULS_SYMM(__side, (__m), (__n)) + 2.0 * FADDS_SYMM(__side, (__m), (__n)) ) -#define FLOPS_CSYMM(__side, __m, __n) (6. * FMULS_SYMM(__side, (__m), (__n)) + 2.0 * FADDS_SYMM(__side, (__m), (__n)) ) -#define FLOPS_DSYMM(__side, __m, __n) ( FMULS_SYMM(__side, (__m), (__n)) + FADDS_SYMM(__side, (__m), (__n)) ) -#define FLOPS_SSYMM(__side, __m, __n) ( FMULS_SYMM(__side, (__m), (__n)) + FADDS_SYMM(__side, (__m), (__n)) ) - -#define FLOPS_ZHERK(__k, __n) (6. * FMULS_HERK((__k), (__n)) + 2.0 * FADDS_HERK((__k), (__n)) ) -#define FLOPS_CHERK(__k, __n) (6. * FMULS_HERK((__k), (__n)) + 2.0 * FADDS_HERK((__k), (__n)) ) - -#define FLOPS_ZSYRK(__k, __n) (6. * FMULS_SYRK((__k), (__n)) + 2.0 * FADDS_SYRK((__k), (__n)) ) -#define FLOPS_CSYRK(__k, __n) (6. * FMULS_SYRK((__k), (__n)) + 2.0 * FADDS_SYRK((__k), (__n)) ) -#define FLOPS_DSYRK(__k, __n) ( FMULS_SYRK((__k), (__n)) + FADDS_SYRK((__k), (__n)) ) -#define FLOPS_SSYRK(__k, __n) ( FMULS_SYRK((__k), (__n)) + FADDS_SYRK((__k), (__n)) ) - -#define FLOPS_ZHER2K(__k, __n) (6. * FMULS_HER2K((__k), (__n)) + 2.0 * FADDS_HER2K((__k), (__n)) ) -#define FLOPS_CHER2K(__k, __n) (6. * FMULS_HER2K((__k), (__n)) + 2.0 * FADDS_HER2K((__k), (__n)) ) - -#define FLOPS_ZSYR2K(__k, __n) (6. * FMULS_SYR2K((__k), (__n)) + 2.0 * FADDS_SYR2K((__k), (__n)) ) -#define FLOPS_CSYR2K(__k, __n) (6. * FMULS_SYR2K((__k), (__n)) + 2.0 * FADDS_SYR2K((__k), (__n)) ) -#define FLOPS_DSYR2K(__k, __n) ( FMULS_SYR2K((__k), (__n)) + FADDS_SYR2K((__k), (__n)) ) -#define FLOPS_SSYR2K(__k, __n) ( FMULS_SYR2K((__k), (__n)) + FADDS_SYR2K((__k), (__n)) ) - -#define FLOPS_ZTRMM(__side, __m, __n) (6. * FMULS_TRMM(__side, (__m), (__n)) + 2.0 * FADDS_TRMM(__side, (__m), (__n)) ) -#define FLOPS_CTRMM(__side, __m, __n) (6. * FMULS_TRMM(__side, (__m), (__n)) + 2.0 * FADDS_TRMM(__side, (__m), (__n)) ) -#define FLOPS_DTRMM(__side, __m, __n) ( FMULS_TRMM(__side, (__m), (__n)) + FADDS_TRMM(__side, (__m), (__n)) ) -#define FLOPS_STRMM(__side, __m, __n) ( FMULS_TRMM(__side, (__m), (__n)) + FADDS_TRMM(__side, (__m), (__n)) ) - -#define FLOPS_ZTRSM(__side, __m, __n) (6. * FMULS_TRSM(__side, (__m), (__n)) + 2.0 * FADDS_TRSM(__side, (__m), (__n)) ) -#define FLOPS_CTRSM(__side, __m, __n) (6. * FMULS_TRSM(__side, (__m), (__n)) + 2.0 * FADDS_TRSM(__side, (__m), (__n)) ) -#define FLOPS_DTRSM(__side, __m, __n) ( FMULS_TRSM(__side, (__m), (__n)) + FADDS_TRSM(__side, (__m), (__n)) ) -#define FLOPS_STRSM(__side, __m, __n) ( FMULS_TRSM(__side, (__m), (__n)) + FADDS_TRSM(__side, (__m), (__n)) ) - -/* - * Lapack - */ -#define FLOPS_ZGETRF(__m, __n) (6. * FMULS_GETRF((__m), (__n)) + 2.0 * FADDS_GETRF((__m), (__n)) ) -#define FLOPS_CGETRF(__m, __n) (6. * FMULS_GETRF((__m), (__n)) + 2.0 * FADDS_GETRF((__m), (__n)) ) -#define FLOPS_DGETRF(__m, __n) ( FMULS_GETRF((__m), (__n)) + FADDS_GETRF((__m), (__n)) ) -#define FLOPS_SGETRF(__m, __n) ( FMULS_GETRF((__m), (__n)) + FADDS_GETRF((__m), (__n)) ) - -#define FLOPS_ZGETRI(__n) (6. * FMULS_GETRI((__n)) + 2.0 * FADDS_GETRI((__n)) ) -#define FLOPS_CGETRI(__n) (6. * FMULS_GETRI((__n)) + 2.0 * FADDS_GETRI((__n)) ) -#define FLOPS_DGETRI(__n) ( FMULS_GETRI((__n)) + FADDS_GETRI((__n)) ) -#define FLOPS_SGETRI(__n) ( FMULS_GETRI((__n)) + FADDS_GETRI((__n)) ) - -#define FLOPS_ZGETRS(__n, __nrhs) (6. * FMULS_GETRS((__n), (__nrhs)) + 2.0 * FADDS_GETRS((__n), (__nrhs)) ) -#define FLOPS_CGETRS(__n, __nrhs) (6. * FMULS_GETRS((__n), (__nrhs)) + 2.0 * FADDS_GETRS((__n), (__nrhs)) ) -#define FLOPS_DGETRS(__n, __nrhs) ( FMULS_GETRS((__n), (__nrhs)) + FADDS_GETRS((__n), (__nrhs)) ) -#define FLOPS_SGETRS(__n, __nrhs) ( FMULS_GETRS((__n), (__nrhs)) + FADDS_GETRS((__n), (__nrhs)) ) - -#define FLOPS_ZPOTRF(__n) (6. * FMULS_POTRF((__n)) + 2.0 * FADDS_POTRF((__n)) ) -#define FLOPS_CPOTRF(__n) (6. * FMULS_POTRF((__n)) + 2.0 * FADDS_POTRF((__n)) ) -#define FLOPS_DPOTRF(__n) ( FMULS_POTRF((__n)) + FADDS_POTRF((__n)) ) -#define FLOPS_SPOTRF(__n) ( FMULS_POTRF((__n)) + FADDS_POTRF((__n)) ) - -#define FLOPS_ZPOTRI(__n) (6. * FMULS_POTRI((__n)) + 2.0 * FADDS_POTRI((__n)) ) -#define FLOPS_CPOTRI(__n) (6. * FMULS_POTRI((__n)) + 2.0 * FADDS_POTRI((__n)) ) -#define FLOPS_DPOTRI(__n) ( FMULS_POTRI((__n)) + FADDS_POTRI((__n)) ) -#define FLOPS_SPOTRI(__n) ( FMULS_POTRI((__n)) + FADDS_POTRI((__n)) ) - -#define FLOPS_ZPOTRS(__n, __nrhs) (6. * FMULS_POTRS((__n), (__nrhs)) + 2.0 * FADDS_POTRS((__n), (__nrhs)) ) -#define FLOPS_CPOTRS(__n, __nrhs) (6. * FMULS_POTRS((__n), (__nrhs)) + 2.0 * FADDS_POTRS((__n), (__nrhs)) ) -#define FLOPS_DPOTRS(__n, __nrhs) ( FMULS_POTRS((__n), (__nrhs)) + FADDS_POTRS((__n), (__nrhs)) ) -#define FLOPS_SPOTRS(__n, __nrhs) ( FMULS_POTRS((__n), (__nrhs)) + FADDS_POTRS((__n), (__nrhs)) ) - -#define FLOPS_ZGEQRF(__m, __n) (6. * FMULS_GEQRF((__m), (__n)) + 2.0 * FADDS_GEQRF((__m), (__n)) ) -#define FLOPS_CGEQRF(__m, __n) (6. * FMULS_GEQRF((__m), (__n)) + 2.0 * FADDS_GEQRF((__m), (__n)) ) -#define FLOPS_DGEQRF(__m, __n) ( FMULS_GEQRF((__m), (__n)) + FADDS_GEQRF((__m), (__n)) ) -#define FLOPS_SGEQRF(__m, __n) ( FMULS_GEQRF((__m), (__n)) + FADDS_GEQRF((__m), (__n)) ) - -#define FLOPS_ZGEQLF(__m, __n) (6. * FMULS_GEQLF((__m), (__n)) + 2.0 * FADDS_GEQLF((__m), (__n)) ) -#define FLOPS_CGEQLF(__m, __n) (6. * FMULS_GEQLF((__m), (__n)) + 2.0 * FADDS_GEQLF((__m), (__n)) ) -#define FLOPS_DGEQLF(__m, __n) ( FMULS_GEQLF((__m), (__n)) + FADDS_GEQLF((__m), (__n)) ) -#define FLOPS_SGEQLF(__m, __n) ( FMULS_GEQLF((__m), (__n)) + FADDS_GEQLF((__m), (__n)) ) - -#define FLOPS_ZGERQF(__m, __n) (6. * FMULS_GERQF((__m), (__n)) + 2.0 * FADDS_GERQF((__m), (__n)) ) -#define FLOPS_CGERQF(__m, __n) (6. * FMULS_GERQF((__m), (__n)) + 2.0 * FADDS_GERQF((__m), (__n)) ) -#define FLOPS_DGERQF(__m, __n) ( FMULS_GERQF((__m), (__n)) + FADDS_GERQF((__m), (__n)) ) -#define FLOPS_SGERQF(__m, __n) ( FMULS_GERQF((__m), (__n)) + FADDS_GERQF((__m), (__n)) ) - -#define FLOPS_ZGELQF(__m, __n) (6. * FMULS_GELQF((__m), (__n)) + 2.0 * FADDS_GELQF((__m), (__n)) ) -#define FLOPS_CGELQF(__m, __n) (6. * FMULS_GELQF((__m), (__n)) + 2.0 * FADDS_GELQF((__m), (__n)) ) -#define FLOPS_DGELQF(__m, __n) ( FMULS_GELQF((__m), (__n)) + FADDS_GELQF((__m), (__n)) ) -#define FLOPS_SGELQF(__m, __n) ( FMULS_GELQF((__m), (__n)) + FADDS_GELQF((__m), (__n)) ) - -#define FLOPS_ZUNGQR(__m, __n, __k) (6. * FMULS_UNGQR((__m), (__n), (__k)) + 2.0 * FADDS_UNGQR((__m), (__n), (__k)) ) -#define FLOPS_CUNGQR(__m, __n, __k) (6. * FMULS_UNGQR((__m), (__n), (__k)) + 2.0 * FADDS_UNGQR((__m), (__n), (__k)) ) -#define FLOPS_DUNGQR(__m, __n, __k) ( FMULS_UNGQR((__m), (__n), (__k)) + FADDS_UNGQR((__m), (__n), (__k)) ) -#define FLOPS_SUNGQR(__m, __n, __k) ( FMULS_UNGQR((__m), (__n), (__k)) + FADDS_UNGQR((__m), (__n), (__k)) ) - -#define FLOPS_ZUNGQL(__m, __n, __k) (6. * FMULS_UNGQL((__m), (__n), (__k)) + 2.0 * FADDS_UNGQL((__m), (__n), (__k)) ) -#define FLOPS_CUNGQL(__m, __n, __k) (6. * FMULS_UNGQL((__m), (__n), (__k)) + 2.0 * FADDS_UNGQL((__m), (__n), (__k)) ) -#define FLOPS_DUNGQL(__m, __n, __k) ( FMULS_UNGQL((__m), (__n), (__k)) + FADDS_UNGQL((__m), (__n), (__k)) ) -#define FLOPS_SUNGQL(__m, __n, __k) ( FMULS_UNGQL((__m), (__n), (__k)) + FADDS_UNGQL((__m), (__n), (__k)) ) - -#define FLOPS_ZORGQR(__m, __n, __k) (6. * FMULS_ORGQR((__m), (__n), (__k)) + 2.0 * FADDS_ORGQR((__m), (__n), (__k)) ) -#define FLOPS_CORGQR(__m, __n, __k) (6. * FMULS_ORGQR((__m), (__n), (__k)) + 2.0 * FADDS_ORGQR((__m), (__n), (__k)) ) -#define FLOPS_DORGQR(__m, __n, __k) ( FMULS_ORGQR((__m), (__n), (__k)) + FADDS_ORGQR((__m), (__n), (__k)) ) -#define FLOPS_SORGQR(__m, __n, __k) ( FMULS_ORGQR((__m), (__n), (__k)) + FADDS_ORGQR((__m), (__n), (__k)) ) - -#define FLOPS_ZORGQL(__m, __n, __k) (6. * FMULS_ORGQL((__m), (__n), (__k)) + 2.0 * FADDS_ORGQL((__m), (__n), (__k)) ) -#define FLOPS_CORGQL(__m, __n, __k) (6. * FMULS_ORGQL((__m), (__n), (__k)) + 2.0 * FADDS_ORGQL((__m), (__n), (__k)) ) -#define FLOPS_DORGQL(__m, __n, __k) ( FMULS_ORGQL((__m), (__n), (__k)) + FADDS_ORGQL((__m), (__n), (__k)) ) -#define FLOPS_SORGQL(__m, __n, __k) ( FMULS_ORGQL((__m), (__n), (__k)) + FADDS_ORGQL((__m), (__n), (__k)) ) - -#define FLOPS_ZUNGRQ(__m, __n, __k) (6. * FMULS_UNGRQ((__m), (__n), (__k)) + 2.0 * FADDS_UNGRQ((__m), (__n), (__k)) ) -#define FLOPS_CUNGRQ(__m, __n, __k) (6. * FMULS_UNGRQ((__m), (__n), (__k)) + 2.0 * FADDS_UNGRQ((__m), (__n), (__k)) ) -#define FLOPS_DUNGRQ(__m, __n, __k) ( FMULS_UNGRQ((__m), (__n), (__k)) + FADDS_UNGRQ((__m), (__n), (__k)) ) -#define FLOPS_SUNGRQ(__m, __n, __k) ( FMULS_UNGRQ((__m), (__n), (__k)) + FADDS_UNGRQ((__m), (__n), (__k)) ) - -#define FLOPS_ZUNGLQ(__m, __n, __k) (6. * FMULS_UNGLQ((__m), (__n), (__k)) + 2.0 * FADDS_UNGLQ((__m), (__n), (__k)) ) -#define FLOPS_CUNGLQ(__m, __n, __k) (6. * FMULS_UNGLQ((__m), (__n), (__k)) + 2.0 * FADDS_UNGLQ((__m), (__n), (__k)) ) -#define FLOPS_DUNGLQ(__m, __n, __k) ( FMULS_UNGLQ((__m), (__n), (__k)) + FADDS_UNGLQ((__m), (__n), (__k)) ) -#define FLOPS_SUNGLQ(__m, __n, __k) ( FMULS_UNGLQ((__m), (__n), (__k)) + FADDS_UNGLQ((__m), (__n), (__k)) ) - -#define FLOPS_ZORGRQ(__m, __n, __k) (6. * FMULS_ORGRQ((__m), (__n), (__k)) + 2.0 * FADDS_ORGRQ((__m), (__n), (__k)) ) -#define FLOPS_CORGRQ(__m, __n, __k) (6. * FMULS_ORGRQ((__m), (__n), (__k)) + 2.0 * FADDS_ORGRQ((__m), (__n), (__k)) ) -#define FLOPS_DORGRQ(__m, __n, __k) ( FMULS_ORGRQ((__m), (__n), (__k)) + FADDS_ORGRQ((__m), (__n), (__k)) ) -#define FLOPS_SORGRQ(__m, __n, __k) ( FMULS_ORGRQ((__m), (__n), (__k)) + FADDS_ORGRQ((__m), (__n), (__k)) ) - -#define FLOPS_ZORGLQ(__m, __n, __k) (6. * FMULS_ORGLQ((__m), (__n), (__k)) + 2.0 * FADDS_ORGLQ((__m), (__n), (__k)) ) -#define FLOPS_CORGLQ(__m, __n, __k) (6. * FMULS_ORGLQ((__m), (__n), (__k)) + 2.0 * FADDS_ORGLQ((__m), (__n), (__k)) ) -#define FLOPS_DORGLQ(__m, __n, __k) ( FMULS_ORGLQ((__m), (__n), (__k)) + FADDS_ORGLQ((__m), (__n), (__k)) ) -#define FLOPS_SORGLQ(__m, __n, __k) ( FMULS_ORGLQ((__m), (__n), (__k)) + FADDS_ORGLQ((__m), (__n), (__k)) ) - -#define FLOPS_ZGEQRS(__m, __n, __nrhs) (6. * FMULS_GEQRS((__m), (__n), (__nrhs)) + 2.0 * FADDS_GEQRS((__m), (__n), (__nrhs)) ) -#define FLOPS_CGEQRS(__m, __n, __nrhs) (6. * FMULS_GEQRS((__m), (__n), (__nrhs)) + 2.0 * FADDS_GEQRS((__m), (__n), (__nrhs)) ) -#define FLOPS_DGEQRS(__m, __n, __nrhs) ( FMULS_GEQRS((__m), (__n), (__nrhs)) + FADDS_GEQRS((__m), (__n), (__nrhs)) ) -#define FLOPS_SGEQRS(__m, __n, __nrhs) ( FMULS_GEQRS((__m), (__n), (__nrhs)) + FADDS_GEQRS((__m), (__n), (__nrhs)) ) - -#define FLOPS_ZTRTRI(__n) (6. * FMULS_TRTRI((__n)) + 2.0 * FADDS_TRTRI((__n)) ) -#define FLOPS_CTRTRI(__n) (6. * FMULS_TRTRI((__n)) + 2.0 * FADDS_TRTRI((__n)) ) -#define FLOPS_DTRTRI(__n) ( FMULS_TRTRI((__n)) + FADDS_TRTRI((__n)) ) -#define FLOPS_STRTRI(__n) ( FMULS_TRTRI((__n)) + FADDS_TRTRI((__n)) ) - -#define FLOPS_ZGEHRD(__n) (6. * FMULS_GEHRD((__n)) + 2.0 * FADDS_GEHRD((__n)) ) -#define FLOPS_CGEHRD(__n) (6. * FMULS_GEHRD((__n)) + 2.0 * FADDS_GEHRD((__n)) ) -#define FLOPS_DGEHRD(__n) ( FMULS_GEHRD((__n)) + FADDS_GEHRD((__n)) ) -#define FLOPS_SGEHRD(__n) ( FMULS_GEHRD((__n)) + FADDS_GEHRD((__n)) ) - -#define FLOPS_ZHETRD(__n) (6. * FMULS_HETRD((__n)) + 2.0 * FADDS_HETRD((__n)) ) -#define FLOPS_CHETRD(__n) (6. * FMULS_HETRD((__n)) + 2.0 * FADDS_HETRD((__n)) ) - -#define FLOPS_ZSYTRD(__n) (6. * FMULS_SYTRD((__n)) + 2.0 * FADDS_SYTRD((__n)) ) -#define FLOPS_CSYTRD(__n) (6. * FMULS_SYTRD((__n)) + 2.0 * FADDS_SYTRD((__n)) ) -#define FLOPS_DSYTRD(__n) ( FMULS_SYTRD((__n)) + FADDS_SYTRD((__n)) ) -#define FLOPS_SSYTRD(__n) ( FMULS_SYTRD((__n)) + FADDS_SYTRD((__n)) ) - -#define FLOPS_ZGEBRD(__m, __n) (6. * FMULS_GEBRD((__m), (__n)) + 2.0 * FADDS_GEBRD((__m), (__n)) ) -#define FLOPS_CGEBRD(__m, __n) (6. * FMULS_GEBRD((__m), (__n)) + 2.0 * FADDS_GEBRD((__m), (__n)) ) -#define FLOPS_DGEBRD(__m, __n) ( FMULS_GEBRD((__m), (__n)) + FADDS_GEBRD((__m), (__n)) ) -#define FLOPS_SGEBRD(__m, __n) ( FMULS_GEBRD((__m), (__n)) + FADDS_GEBRD((__m), (__n)) ) - -/* - * Norms - */ -#define FMULS_LANGE(__m, __n) ((double)(__m) * (double)(__n)) -#define FADDS_LANGE(__m, __n) ((double)(__m) * (double)(__n)) - -#endif /* _flops_h_ */ diff --git a/timing/time_zgelqf.c b/timing/time_zgelqf.c deleted file mode 100644 index bbe2cc2a8c5438f344eb4aa548b6bb56a242ce22..0000000000000000000000000000000000000000 --- a/timing/time_zgelqf.c +++ /dev/null @@ -1,81 +0,0 @@ -/** - * - * @file time_zgelqf.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2016-04-13 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgelqf" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GELQF(M, N) -#define _FADDS FADDS_GELQF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *T; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt(M, N, A, LDA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels(M, N, &T, P, Q); - - /* Save AT in lapack layout for check */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - - START_TIMING(); - CHAMELEON_zgelqf( M, N, A, LDA, T ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - PASTE_CODE_ALLOCATE_COPY( B, 1, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - CHAMELEON_zgelqs(M, N, NRHS, A, LDA, T, X, LDB); - - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free( Acpy ); - free( B ); - free( X ); - } - - /* Free Workspace */ - CHAMELEON_Dealloc_Workspace( &T ); - free( A ); - - return 0; -} diff --git a/timing/time_zgelqf_tile.c b/timing/time_zgelqf_tile.c deleted file mode 100644 index 0acbd3de45b3b75bdbe5e70c6e810aca34899e09..0000000000000000000000000000000000000000 --- a/timing/time_zgelqf_tile.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zgelqf_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2016-04-13 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgelqf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GELQF( M, N ) -#define _FADDS FADDS_GELQF( M, N ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descT; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile( descA, 5373 ); - - /* Save A for check */ - if (check == 1 && M == N){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels_Tile(M, N, &descT, P, Q); - - /* CHAMELEON ZGEQRF */ - START_TIMING(); - CHAMELEON_zgelqf_Tile( descA, descT ); - STOP_TIMING(); - - /* Check the solution */ - if ( check && M == N ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 2264 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - CHAMELEON_zgelqs_Tile( descA, descT, descX ); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ) - PASTE_CODE_FREE_MATRIX( descAC ) - PASTE_CODE_FREE_MATRIX( descB ) - } - - /* Free data */ - CHAMELEON_Dealloc_Workspace(&descT); - PASTE_CODE_FREE_MATRIX( descA ) - - return 0; -} diff --git a/timing/time_zgels.c b/timing/time_zgels.c deleted file mode 100644 index fbf9f8f6bc6cb85984a515ee0c5595211fe3ec0c..0000000000000000000000000000000000000000 --- a/timing/time_zgels.c +++ /dev/null @@ -1,78 +0,0 @@ -/** - * - * @file time_zgels.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgels" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GEQRF( M, N ) + FMULS_GEQRS( M, N, NRHS )) -#define _FADDS (FADDS_GEQRF( M, N ) + FADDS_GEQRS( M, N, NRHS )) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *T; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( x, 1, CHAMELEON_Complex64_t, LDB, NRHS); - PASTE_CODE_ALLOCATE_MATRIX( Acpy, check, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( b, check, CHAMELEON_Complex64_t, LDB, NRHS); - - /* Initialize Data */ - CHAMELEON_zplrnt( M, N, A, LDA, 453 ); - CHAMELEON_zplrnt( M, NRHS, x, LDB, 5673 ); - - CHAMELEON_Alloc_Workspace_zgels(M, N, &T, P, Q); - - /* Save A and b */ - if (check) { - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, N, A, LDA, Acpy, LDA); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR, 'A', M, NRHS, x, LDB, b, LDB); - } - - START_TIMING(); - CHAMELEON_zgels( ChamNoTrans, M, N, NRHS, A, LDA, T, x, LDB ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, b, x, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - free(Acpy); free(b); - } - - CHAMELEON_Dealloc_Workspace( &T ); - free( A ); - free( x ); - - return 0; -} diff --git a/timing/time_zgels_tile.c b/timing/time_zgels_tile.c deleted file mode 100644 index c2ca584864dab0860f8803da8ccf987e3cfce7bf..0000000000000000000000000000000000000000 --- a/timing/time_zgels_tile.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zgels_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgels_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GEQRF( M, N ) + FMULS_GEQRS( M, N, NRHS )) -#define _FADDS (FADDS_GEQRF( M, N ) + FADDS_GEQRS( M, N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descT; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile( descA, 5373 ); - CHAMELEON_zplrnt_Tile( descX, 673 ); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels_Tile(M, N, &descT, P, Q); - - /* Save A and B for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - } - - /* CHAMELEON ZGELS */ - START_TIMING(); - CHAMELEON_zgels_Tile( ChamNoTrans, descA, descT, descX ); - STOP_TIMING(); - - /* Allocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descT); - - /* Check the solution */ - if ( check ) - { - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descX ); - - return 0; -} diff --git a/timing/time_zgemm.c b/timing/time_zgemm.c deleted file mode 100644 index 1b332945a702549770c0e31067ea6f94fc268280..0000000000000000000000000000000000000000 --- a/timing/time_zgemm.c +++ /dev/null @@ -1,79 +0,0 @@ -/** - * - * @file time_zgemm.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgemm" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEMM(M, N, K) -#define _FADDS FADDS_GEMM(M, N, K) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAMELEON_Complex64_t alpha, beta; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - LDB = chameleon_max(K, iparam[IPARAM_LDB]); - LDC = chameleon_max(M, iparam[IPARAM_LDC]); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, K ); - PASTE_CODE_ALLOCATE_MATRIX( B, 1, CHAMELEON_Complex64_t, LDB, N ); - PASTE_CODE_ALLOCATE_MATRIX( C, 1, CHAMELEON_Complex64_t, LDC, N ); - PASTE_CODE_ALLOCATE_MATRIX( C2, check, CHAMELEON_Complex64_t, LDC, N ); - - CHAMELEON_zplrnt( M, K, A, LDA, 453 ); - CHAMELEON_zplrnt( K, N, B, LDB, 5673 ); - CHAMELEON_zplrnt( M, N, C, LDC, 740 ); - - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha); - LAPACKE_zlarnv_work(1, ISEED, 1, &beta ); - - if (check) - { - memcpy(C2, C, LDC*N*sizeof(CHAMELEON_Complex64_t)); - } - - START_TIMING(); - CHAMELEON_zgemm( ChamNoTrans, ChamNoTrans, M, N, K, alpha, A, LDA, B, LDB, beta, C, LDC ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_RES] = 0.0; - dparam[IPARAM_RES] = z_check_gemm( ChamNoTrans, ChamNoTrans, M, N, K, - alpha, A, LDA, B, LDB, beta, C, C2, LDC, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free(C2); - } - - free( A ); - free( B ); - free( C ); - - return 0; -} diff --git a/timing/time_zgemm_tile.c b/timing/time_zgemm_tile.c deleted file mode 100644 index b558d493987a14211105e306b5688c85534c7a5a..0000000000000000000000000000000000000000 --- a/timing/time_zgemm_tile.c +++ /dev/null @@ -1,87 +0,0 @@ -/** - * - * @file time_zgemm_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgemm_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEMM(M, N, K) -#define _FADDS FADDS_GEMM(M, N, K) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAMELEON_Complex64_t alpha, beta; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - - LDB = chameleon_max(K, iparam[IPARAM_LDB]); - LDC = chameleon_max(M, iparam[IPARAM_LDC]); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, K ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, K, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descC, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDC, M, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt_Tile( descA, 5373 ); - CHAMELEON_zplrnt_Tile( descB, 7672 ); - CHAMELEON_zplrnt_Tile( descC, 6387 ); - -#if !defined(CHAMELEON_SIMULATION) - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha); - LAPACKE_zlarnv_work(1, ISEED, 1, &beta); -#else - alpha = 1.5; - beta = -2.3; -#endif - - /* Save C for check */ - PASTE_TILE_TO_LAPACK( descC, C2, check, CHAMELEON_Complex64_t, LDC, N ); - - START_TIMING(); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, alpha, descA, descB, beta, descC ); - STOP_TIMING(); - -#if !defined(CHAMELEON_SIMULATION) - /* Check the solution */ - if (check) - { - PASTE_TILE_TO_LAPACK( descA, A, check, CHAMELEON_Complex64_t, LDA, K ); - PASTE_TILE_TO_LAPACK( descB, B, check, CHAMELEON_Complex64_t, LDB, N ); - PASTE_TILE_TO_LAPACK( descC, C, check, CHAMELEON_Complex64_t, LDC, N ); - - dparam[IPARAM_RES] = z_check_gemm( ChamNoTrans, ChamNoTrans, M, N, K, - alpha, A, LDA, B, LDB, beta, C, C2, LDC, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free(A); free(B); free(C); free(C2); - } -#endif - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descB ); - PASTE_CODE_FREE_MATRIX( descC ); - return 0; -} diff --git a/timing/time_zgeqrf.c b/timing/time_zgeqrf.c deleted file mode 100644 index d167515bfc2bafdb206032bb0444e5407d844b32..0000000000000000000000000000000000000000 --- a/timing/time_zgeqrf.c +++ /dev/null @@ -1,81 +0,0 @@ -/** - * - * @file time_zgeqrf.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgeqrf" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEQRF(M, N) -#define _FADDS FADDS_GEQRF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *T; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt(M, N, A, LDA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels(M, N, &T, P, Q); - - /* Save AT in lapack layout for check */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - - START_TIMING(); - CHAMELEON_zgeqrf( M, N, A, LDA, T ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - PASTE_CODE_ALLOCATE_COPY( B, 1, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - CHAMELEON_zgeqrs(M, N, NRHS, A, LDA, T, X, LDB); - - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free( Acpy ); - free( B ); - free( X ); - } - - /* Free Workspace */ - CHAMELEON_Dealloc_Workspace( &T ); - free( A ); - - return 0; -} diff --git a/timing/time_zgeqrf_hqr.c b/timing/time_zgeqrf_hqr.c deleted file mode 100644 index b7c16942516e9bae809fdc964af161fbbb9e58fb..0000000000000000000000000000000000000000 --- a/timing/time_zgeqrf_hqr.c +++ /dev/null @@ -1,105 +0,0 @@ -/** - * - * @file time_zgeqrf_hqr.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Raphael Boucherie - * @date 2017-05-29 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgeqrf_param" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEQRF(M, N) -#define _FADDS FADDS_GEQRF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *TS; - CHAM_desc_t *TT; - libhqr_tree_t qrtree; - libhqr_matrix_t matrix; - int hlvl, llvl, qr_a, domino; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt(M, N, A, LDA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels(M, N, &TS, P, Q); - CHAMELEON_Alloc_Workspace_zgels(M, N, &TT, P, Q); - - /* Save AT in lapack layout for check */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - - /* Initialize matrix */ - matrix.mt = TS->mt; - matrix.nt = TS->nt; - matrix.nodes = 1; - matrix.p = 1; - - /* Initialize qrtree */ - hlvl = iparam[IPARAM_HIGHLVL_TREE]; - llvl = iparam[IPARAM_LOWLVL_TREE]; - qr_a = iparam[IPARAM_RHBLK]; - domino = iparam[IPARAM_QR_DOMINO]; - - libhqr_init_hqr( &qrtree, - ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, - &matrix, llvl, hlvl, qr_a, P, domino, 0); - - START_TIMING(); - CHAMELEON_zgeqrf_param(&qrtree, M, N, A, LDA, TS, TT ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - PASTE_CODE_ALLOCATE_COPY( B, 1, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - CHAMELEON_zgeqrs_param(&qrtree, M, N, NRHS, A, LDA, TS, TT, X, LDB); - - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free( Acpy ); - free( B ); - free( X ); - } - - /* Free Workspace */ - libhqr_finalize( &qrtree ); - CHAMELEON_Dealloc_Workspace( &TS ); - CHAMELEON_Dealloc_Workspace( &TT ); - free( A ); - - return 0; -} diff --git a/timing/time_zgeqrf_hqr_tile.c b/timing/time_zgeqrf_hqr_tile.c deleted file mode 100644 index a4ebcc1c97e328def67be6c683a3eebd88e9b041..0000000000000000000000000000000000000000 --- a/timing/time_zgeqrf_hqr_tile.c +++ /dev/null @@ -1,111 +0,0 @@ -/** - * - * @file time_zgeqrf_hqr_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Raphael Boucherie - * @date 2017-06-13 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgeqrf_param" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEQRF(M, N) -#define _FADDS FADDS_GEQRF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *TS; - CHAM_desc_t *TT; - libhqr_tree_t qrtree; - libhqr_matrix_t matrix; - int hlvl, llvl, qr_a, domino; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA0, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile( descA, 5373 ); - - /* Save A for check */ - if (check == 1 && M == N){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descA0); - } - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels(M, N, &TS, P, Q); - CHAMELEON_Alloc_Workspace_zgels(M, N, &TT, P, Q); - - /* Initialize matrix */ - matrix.mt = TS->mt; - matrix.nt = TS->nt; - matrix.nodes = 1; - matrix.p = 1; - - /* Initialize qrtree */ - hlvl = iparam[IPARAM_HIGHLVL_TREE]; - llvl = iparam[IPARAM_LOWLVL_TREE]; - qr_a = iparam[IPARAM_RHBLK]; - domino = iparam[IPARAM_QR_DOMINO]; - - libhqr_init_hqr( &qrtree, - ( M >= N ) ? LIBHQR_QR : LIBHQR_LQ, - &matrix, llvl, hlvl, qr_a, P, domino, 0); - - START_TIMING(); - CHAMELEON_zgeqrf_param_Tile(&qrtree, descA, TS, TT ); - STOP_TIMING(); - - /* Check the solution */ - if ( check && M == N) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 2264 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - CHAMELEON_zgeqrs_param_Tile(&qrtree, descA, TS, TT, descX ); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descA0); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descA0, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ) - PASTE_CODE_FREE_MATRIX( descA0 ) - PASTE_CODE_FREE_MATRIX( descB ) - } - - /* Free Workspace */ - libhqr_finalize( &qrtree ); - CHAMELEON_Dealloc_Workspace( &TS ); - CHAMELEON_Dealloc_Workspace( &TT ); - free( descA ); - - return 0; -} diff --git a/timing/time_zgeqrf_tile.c b/timing/time_zgeqrf_tile.c deleted file mode 100644 index 1e117c5e561632b895edbdbe4e879b22d2221475..0000000000000000000000000000000000000000 --- a/timing/time_zgeqrf_tile.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zgeqrf_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgeqrf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEQRF( M, N ) -#define _FADDS FADDS_GEQRF( M, N ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descT; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA0, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile( descA, 5373 ); - - /* Save A for check */ - if (check == 1 && M == N){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descA0); - } - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels_Tile(M, N, &descT, P, Q); - - /* CHAMELEON ZGEQRF */ - START_TIMING(); - CHAMELEON_zgeqrf_Tile( descA, descT ); - STOP_TIMING(); - - /* Check the solution */ - if ( check && M == N ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 2264 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - CHAMELEON_zgeqrs_Tile( descA, descT, descX ); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descA0); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descA0, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ) - PASTE_CODE_FREE_MATRIX( descA0 ) - PASTE_CODE_FREE_MATRIX( descB ) - } - - /* Free data */ - CHAMELEON_Dealloc_Workspace(&descT); - PASTE_CODE_FREE_MATRIX( descA ) - - return 0; -} diff --git a/timing/time_zgeqrs_tile.c b/timing/time_zgeqrs_tile.c deleted file mode 100644 index 39cf2d2ac15646df1600b92945dab80a47f94462..0000000000000000000000000000000000000000 --- a/timing/time_zgeqrs_tile.c +++ /dev/null @@ -1,85 +0,0 @@ -/** - * - * @file time_zgeqrs_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-07-28 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgeqrs_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEQRS( M, N, NRHS ) -#define _FADDS FADDS_GEQRS( M, N, NRHS ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descT; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - check = 1; - M = N; - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, ( check && M == N ), CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile( descA, 5373 ); - - /* Save A for check */ - if (check == 1 && M == N){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgels_Tile(M, N, &descT, P, Q); - - /* CHAMELEON ZGEQRF */ - CHAMELEON_zgeqrf_Tile( descA, descT ); - - /* Check the solution */ - if ( check && M == N ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 2264 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - START_TIMING(); - CHAMELEON_zgeqrs_Tile( descA, descT, descX ); - STOP_TIMING(); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ) - } - - /* Free data */ - CHAMELEON_Dealloc_Workspace(&descT); - PASTE_CODE_FREE_MATRIX( descA ); - - return 0; -} diff --git a/timing/time_zgesv_incpiv.c b/timing/time_zgesv_incpiv.c deleted file mode 100644 index 8daba23528aec299c9f60259cd5b276c51e4345d..0000000000000000000000000000000000000000 --- a/timing/time_zgesv_incpiv.c +++ /dev/null @@ -1,77 +0,0 @@ -/** - * - * @file time_zgesv_incpiv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgesv_incpiv" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRF( N, N ) + FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRF( N, N ) + FADDS_GETRS( N, NRHS )) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *L; - int *piv; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - - /* Initialize Data */ - CHAMELEON_zplrnt( N, N, A, LDA, 51 ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - - CHAMELEON_Alloc_Workspace_zgesv_incpiv(N, &L, &piv, P, Q); - - /* Save A and b */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - PASTE_CODE_ALLOCATE_COPY( B, check, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - START_TIMING(); - CHAMELEON_zgesv_incpiv( N, NRHS, A, N, L, piv, X, LDB ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_RES] = z_check_solution(N, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - free(Acpy); free(B); - } - - CHAMELEON_Dealloc_Workspace( &L ); - free( piv ); - free( X ); - free( A ); - - - return 0; -} diff --git a/timing/time_zgesv_incpiv_tile.c b/timing/time_zgesv_incpiv_tile.c deleted file mode 100644 index cb23145ad351a3b31a68a7206284cf768630e4af..0000000000000000000000000000000000000000 --- a/timing/time_zgesv_incpiv_tile.c +++ /dev/null @@ -1,85 +0,0 @@ -/** - * - * @file time_zgesv_incpiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgesv_incpiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRF( N, N ) + FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRF( N, N ) + FADDS_GETRS( N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descL; - int *piv; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS );; - - /* Initialize A and b */ - CHAMELEON_zplrnt_Tile( descA, 8796 ); - CHAMELEON_zplrnt_Tile( descX, 7732 ); - - /* Save AT and bT in lapack layout for check */ - /* Save AT and bT for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - } - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgesv_incpiv_Tile(N, &descL, &piv, P, Q); - - START_TIMING(); - CHAMELEON_zgesv_incpiv_Tile( descA, descL, piv, descX ); - STOP_TIMING(); - - /* Allocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descL); - - /* Check the solution */ - if ( check ) - { - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descX ); - free( piv ); - - return 0; -} diff --git a/timing/time_zgesv_nopiv.c b/timing/time_zgesv_nopiv.c deleted file mode 100644 index c64107f5fbaf9e32863b542d43af5f97c7974435..0000000000000000000000000000000000000000 --- a/timing/time_zgesv_nopiv.c +++ /dev/null @@ -1,71 +0,0 @@ -/** - * - * @file time_zgesv_nopiv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgesv_nopiv" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRF( N, N ) + FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRF( N, N ) + FADDS_GETRS( N, NRHS )) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - - /* Initialize Data */ - CHAMELEON_zplrnt( N, N, A, LDA, 51 ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - - /* Save A and b */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - PASTE_CODE_ALLOCATE_COPY( B, check, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - START_TIMING(); - CHAMELEON_zgesv_nopiv( N, NRHS, A, N, X, LDB ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_RES] = z_check_solution(N, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - free(Acpy); free(B); - } - - free( X ); - free( A ); - - - return 0; -} diff --git a/timing/time_zgesv_nopiv_tile.c b/timing/time_zgesv_nopiv_tile.c deleted file mode 100644 index 5e97094793ba3e07cdb511117aa5df48bdad4a44..0000000000000000000000000000000000000000 --- a/timing/time_zgesv_nopiv_tile.c +++ /dev/null @@ -1,76 +0,0 @@ -/** - * - * @file time_zgesv_nopiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgesv_nopiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRF( N, N ) + FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRF( N, N ) + FADDS_GETRS( N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS );; - - /* Initialize A and b */ - CHAMELEON_zplrnt_Tile( descA, 8796 ); - CHAMELEON_zplrnt_Tile( descX, 7732 ); - - /* Save AT and bT in lapack layout for check */ - /* Save AT and bT for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - } - - START_TIMING(); - CHAMELEON_zgesv_nopiv_Tile( descA, descX ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descX ); - - return 0; -} diff --git a/timing/time_zgesvd_tile.c b/timing/time_zgesvd_tile.c deleted file mode 100644 index 3803d670347768498d1c01769c811da0abcc4f26..0000000000000000000000000000000000000000 --- a/timing/time_zgesvd_tile.c +++ /dev/null @@ -1,79 +0,0 @@ -/** - * - * @file time_zgesvd_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2016-12-09 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zheev_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GEBRD( M, N ) -#define _FADDS FADDS_GEBRD( M, N ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - CHAM_desc_t *descT; - int jobu = ChamVec; - int jobvt = ChamVec; - int INFO; - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX( VT, (jobvt == ChamVec), CHAMELEON_Complex64_t, N, N ); - PASTE_CODE_ALLOCATE_MATRIX( U, (jobu == ChamVec), CHAMELEON_Complex64_t, M, M ); - PASTE_CODE_ALLOCATE_MATRIX( S, 1, double, N, 1 ); - - /* Initialize Data */ - CHAMELEON_zplrnt_Tile(descA, 51 ); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgesvd(N, N, &descT, 1, 1); - - if ( jobu == ChamVec ) { - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', M, M, 0., 1., U, M); - } - if ( jobvt == ChamVec ) { - LAPACKE_zlaset_work(LAPACK_COL_MAJOR, 'A', N, N, 0., 1., VT, N); - } - - START_TIMING(); - INFO = CHAMELEON_zgesvd_Tile(jobu, jobvt, descA, S, descT, U, M, VT, N); - STOP_TIMING(); - - if( INFO != 0 ) { - printf(" ERROR OCCURED INFO %d\n",INFO); - } - - /* DeAllocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descT); - - if ( U != NULL ) { - free( U ); - } - if ( VT != NULL) { - free( VT ); - } - PASTE_CODE_FREE_MATRIX( descA ); - free( S ); - - (void)dparam; - return 0; -} diff --git a/timing/time_zgetrf_incpiv.c b/timing/time_zgetrf_incpiv.c deleted file mode 100644 index 2e13d00f16080de6cbfcdacb5871587f997cdf1c..0000000000000000000000000000000000000000 --- a/timing/time_zgetrf_incpiv.c +++ /dev/null @@ -1,80 +0,0 @@ -/** - * - * @file time_zgetrf_incpiv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrf_incpiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GETRF(M, N) -#define _FADDS FADDS_GETRF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *L; - int *piv; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt(M, N, A, LDA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgesv_incpiv( chameleon_min(M,N), &L, &piv, P, Q); - - /* Save AT in lapack layout for check */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - - START_TIMING(); - CHAMELEON_zgetrf_incpiv( M, N, A, LDA, L, piv ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - PASTE_CODE_ALLOCATE_COPY( B, 1, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - CHAMELEON_zgetrs_incpiv( ChamNoTrans, N, NRHS, A, LDA, L, piv, X, LDB ); - - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - - free( Acpy ); free( B ); free( X ); - } - - free( A ); - free( L ); - free( piv ); - - return 0; -} diff --git a/timing/time_zgetrf_incpiv_tile.c b/timing/time_zgetrf_incpiv_tile.c deleted file mode 100644 index 619aacb392c0544043ca3b262810d4ab22f91ad5..0000000000000000000000000000000000000000 --- a/timing/time_zgetrf_incpiv_tile.c +++ /dev/null @@ -1,86 +0,0 @@ -/** - * - * @file time_zgetrf_incpiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrf_incpiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GETRF(M, N) -#define _FADDS FADDS_GETRF(M, N) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descL; - int *piv; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile(descA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgesv_incpiv_Tile(chameleon_min(M,N), &descL, &piv, P, Q); - - /* Save A for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - START_TIMING(); - CHAMELEON_zgetrf_incpiv_Tile( descA, descL, piv ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - CHAMELEON_zplrnt_Tile( descX, 7732 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - CHAMELEON_zgetrs_incpiv_Tile( descA, descL, piv, descX ); - - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - /* Deallocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descL); - - PASTE_CODE_FREE_MATRIX( descA ); - free( piv ); - - return 0; -} diff --git a/timing/time_zgetrf_nopiv.c b/timing/time_zgetrf_nopiv.c deleted file mode 100644 index 24c267a9c3d35a0ac1c512eeb51cd91fde8fb88e..0000000000000000000000000000000000000000 --- a/timing/time_zgetrf_nopiv.c +++ /dev/null @@ -1,72 +0,0 @@ -/** - * - * @file time_zgetrf_nopiv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GETRF(M, N) -#define _FADDS FADDS_GETRF(M, N) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize Data */ - CHAMELEON_zplrnt(M, N, A, LDA, 3456); - - /* Save AT in lapack layout for check */ - PASTE_CODE_ALLOCATE_COPY( Acpy, check, CHAMELEON_Complex64_t, A, LDA, N ); - - START_TIMING(); - CHAMELEON_zgetrf_nopiv( M, N, A, LDA ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, X, LDB, 7732 ); - PASTE_CODE_ALLOCATE_COPY( B, 1, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - CHAMELEON_zgetrs_nopiv( ChamNoTrans, N, NRHS, A, LDA, X, LDB ); - - dparam[IPARAM_RES] = z_check_solution(M, N, NRHS, Acpy, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - free(Acpy); free(B); free(X); - } - - free(A); - - return 0; -} diff --git a/timing/time_zgetrf_nopiv_tile.c b/timing/time_zgetrf_nopiv_tile.c deleted file mode 100644 index f56cd95e99e954abf3892b1d61a5fee103d3fbb3..0000000000000000000000000000000000000000 --- a/timing/time_zgetrf_nopiv_tile.c +++ /dev/null @@ -1,85 +0,0 @@ -/** - * - * @file time_zgetrf_nopiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_GETRF(M, N) -#define _FADDS FADDS_GETRF(M, N) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile(descA, 3456); - - /* Save A for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - /** - * Consider this optimization on some heterogenous platforms and matrix sizes. - * Often, TRSM kernel on GPU yields significantly less performance rate than GEMM, - * while performances are similar on CPU. On this algorithm it is therefore - * recommended to execute all TRSMs (~low amount) on CPU to increase GPU efficiency. - */ - //RUNTIME_zlocality_onerestrict( CHAMELEON_TRSM, STARPU_CPU ); - - START_TIMING(); - CHAMELEON_zgetrf_nopiv_Tile( descA ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - CHAMELEON_zplrnt_Tile( descX, 7732 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - CHAMELEON_zgetrs_nopiv_Tile( descA, descX ); - - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - - return 0; -} diff --git a/timing/time_zgetri_tile.c b/timing/time_zgetri_tile.c deleted file mode 100644 index b64c5707952953268251b4821a82d04cffa2023b..0000000000000000000000000000000000000000 --- a/timing/time_zgetri_tile.c +++ /dev/null @@ -1,256 +0,0 @@ -/** - * - * @file time_zgetri_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetri_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRF(M, N) + FMULS_GETRI( N )) -#define _FADDS (FADDS_GETRF(M, N) + FADDS_GETRI( N )) - -//#define GETRI_SYNC - -#include "./timing.c" - -/*------------------------------------------------------------------------ - * Check the factorization of the matrix A2 - */ -#if 0 -static int check_getri_factorization(CHAM_desc_t *descA1, CHAM_desc_t *descA2, int *IPIV) -{ - int info_factorization; - double Rnorm, Anorm, Xnorm, Bnorm, result; - double *work = (double *)malloc((descA1->m)*sizeof(double)); - double eps = LAPACKE_dlamch_work('e'); - CHAM_desc_t *descB, *descX; - CHAMELEON_Complex64_t *b = (CHAMELEON_Complex64_t *)malloc((descA1->m)*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *x = (CHAMELEON_Complex64_t *)malloc((descA1->m)*sizeof(CHAMELEON_Complex64_t)); - - CHAMELEON_Desc_Create(&descB, b, ChamComplexDouble, descA1->mb, descA1->nb, descA1->bsiz, - descA1->m, 1, 0, 0, descA1->m, 1, 1, 1); - CHAMELEON_Desc_Create(&descX, x, ChamComplexDouble, descA1->mb, descA1->nb, descA1->bsiz, - descA1->m, 1, 0, 0, descA1->m, 1, 1, 1); - - CHAMELEON_zplrnt_Tile( descX, 537 ); - CHAMELEON_zlacpy_Tile( ChamUpperLower, descX, descB); - - CHAMELEON_zgetrs_Tile( ChamNoTrans, descA2, IPIV, descX ); - - Xnorm = CHAMELEON_zlange_Tile(ChamInfNorm, descX, work); - Anorm = CHAMELEON_zlange_Tile(ChamInfNorm, descA1, work); - Bnorm = CHAMELEON_zlange_Tile(ChamInfNorm, descB, work); - - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, - (CHAMELEON_Complex64_t)1., descA1, descX, - (CHAMELEON_Complex64_t)-1., descB); - - Rnorm = CHAMELEON_zlange_Tile(ChamInfNorm, descB, work); - - if (getenv("CHAMELEON_TESTING_VERBOSE")) - printf( "||A||_oo=%f\n||X||_oo=%f\n||B||_oo=%f\n||A X - B||_oo=%e\n", Anorm, Xnorm, Bnorm, Rnorm ); - - result = Rnorm / ( (Anorm*Xnorm+Bnorm)*(descA1->m)*eps ) ; - printf("============\n"); - printf("Checking the Residual of the solution \n"); - printf("-- ||Ax-B||_oo/((||A||_oo||x||_oo+||B||_oo).N.eps) = %e \n", result); - - if ( isnan(Xnorm) || isinf(Xnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - printf("-- The factorization is suspicious ! \n"); - info_factorization = 1; - } - else{ - printf("-- The factorization is CORRECT ! \n"); - info_factorization = 0; - } - free(x); free(b); free(work); - CHAMELEON_Desc_Destroy(&descB); - CHAMELEON_Desc_Destroy(&descX); - - return info_factorization; -} -#endif - -/*------------------------------------------------------------------------ - * Check the accuracy of the computed inverse - */ - -static int check_getri_inverse(CHAM_desc_t *descA1, CHAM_desc_t *descA2, int *IPIV, double *dparam ) -{ - double Rnorm, Anorm, Ainvnorm, result; - double *W = (double *)malloc(descA1->n*sizeof(double)); - CHAMELEON_Complex64_t *work = (CHAMELEON_Complex64_t *)malloc(descA1->n*descA1->n*sizeof(CHAMELEON_Complex64_t)); - double eps = LAPACKE_dlamch_work('e'); - CHAM_desc_t *descW; - - CHAMELEON_Desc_Create(&descW, work, ChamComplexDouble, descA1->mb, descA1->nb, descA1->bsiz, - descA1->m, descA1->n, 0, 0, descA1->m, descA1->n); - - CHAMELEON_zlaset_Tile( ChamUpperLower, (CHAMELEON_Complex64_t)0., (CHAMELEON_Complex64_t)1., descW); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, - (CHAMELEON_Complex64_t)-1., descA2, descA1, - (CHAMELEON_Complex64_t)1., descW); - - Anorm = CHAMELEON_zlange_Tile(ChamInfNorm, descA1, W); - Ainvnorm = CHAMELEON_zlange_Tile(ChamInfNorm, descA2, W); - Rnorm = CHAMELEON_zlange_Tile(ChamInfNorm, descW, W); - - dparam[IPARAM_ANORM] = Anorm; - dparam[IPARAM_BNORM] = Ainvnorm; - - result = Rnorm / ( (Anorm*Ainvnorm)*descA1->m*eps ) ; - dparam[IPARAM_RES] = Rnorm; - - if ( isnan(Ainvnorm) || isinf(Ainvnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - dparam[IPARAM_XNORM] = -1.; - } - else{ - dparam[IPARAM_XNORM] = 0.; - } - - CHAMELEON_Desc_Destroy(&descW); - free(W); - free(work); - - return CHAMELEON_SUCCESS; -} - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t descW; - int ret = 0; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - if ( M != N ) { - fprintf(stderr, "This timing works only with M == N\n"); - return -1; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA2, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX( piv, 1, int, N, 1 ); - - CHAMELEON_Alloc_Workspace_zgetri_Tile_Async(descA, &descW); - CHAMELEON_zplrnt_Tile( descA, 3453 ); - - if ( check ) { - CHAMELEON_zlacpy_Tile( ChamUpperLower, descA, descA2 ); - } - - /* CHAMELEON ZGETRF / ZTRTRI / ZTRSMRV */ - { -#if defined(TRACE_BY_SEQUENCE) - RUNTIME_sequence_t *sequence; - RUNTIME_request_t request[4] = { RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER }; - - CHAMELEON_Sequence_Create(&sequence); - - if ( ! iparam[IPARAM_ASYNC] ) { - - START_TIMING(); - CHAMELEON_zgetrf_Tile_Async( descA, piv, sequence, &request[0] ); - CHAMELEON_Sequence_Wait(sequence); - - CHAMELEON_ztrtri_Tile_Async( ChamUpper, ChamNonUnit, descA, sequence, &request[1] ); - CHAMELEON_Sequence_Wait(sequence); - - CHAMELEON_ztrsmrv_Tile_Async( ChamRight, ChamLower, ChamNoTrans, ChamUnit, - (CHAMELEON_Complex64_t) 1.0, descA, &descW, - sequence, &request[2] ); - CHAMELEON_Sequence_Wait(sequence); - - CHAMELEON_zlaswpc_Tile_Async( descA, 1, descA->m, piv, -1, - sequence, &request[3] ); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - STOP_TIMING(); - - } else { - - START_TIMING(); - CHAMELEON_zgetrf_Tile_Async( descA, piv, sequence, &request[0]); - CHAMELEON_ztrtri_Tile_Async( ChamUpper, ChamNonUnit, - descA, sequence, &request[1] ); - CHAMELEON_ztrsmrv_Tile_Async( ChamRight, ChamLower, ChamNoTrans, ChamUnit, - (CHAMELEON_Complex64_t) 1.0, - descA, &descW, sequence, &request[2] ); - CHAMELEON_zlaswpc_Tile_Async( descA, 1, descA->m, piv, -1, - sequence, &request[3] ); - - /* Wait for everything */ - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait( sequence ); - STOP_TIMING(); - - } - - CHAMELEON_Sequence_Destroy(sequence[0]); - CHAMELEON_Sequence_Destroy(sequence[1]); - CHAMELEON_Sequence_Destroy(sequence[2]); - CHAMELEON_Sequence_Destroy(sequence[3]); - -#else - if ( ! iparam[IPARAM_ASYNC] ) { - - START_TIMING(); - CHAMELEON_zgetrf_Tile(descA, piv); - CHAMELEON_ztrtri_Tile(ChamUpper, ChamNonUnit, descA); - CHAMELEON_ztrsmrv_Tile(ChamRight, ChamLower, ChamNoTrans, ChamUnit, - (CHAMELEON_Complex64_t) 1.0, descA, &descW); - CHAMELEON_zlaswpc_Tile(descA, 1, descA->m, piv, -1); - STOP_TIMING(); - - } else { - - RUNTIME_sequence_t *sequence; - RUNTIME_request_t request[2] = { RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER }; - - CHAMELEON_Sequence_Create(&sequence); - - START_TIMING(); - CHAMELEON_zgetrf_Tile_Async(descA, piv, sequence, &request[0]); - CHAMELEON_zgetri_Tile_Async(descA, piv, &descW, sequence, &request[1]); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - STOP_TIMING(); - - CHAMELEON_Sequence_Destroy(sequence); - } -#endif - } - - /* Check the solution */ - if ( check ) - { - ret = check_getri_inverse(descA2, descA, piv, dparam); - - PASTE_CODE_FREE_MATRIX( descA2 ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - free(descW.mat); - free( piv ); - - return ret; -} diff --git a/timing/time_zgetrs_incpiv_tile.c b/timing/time_zgetrs_incpiv_tile.c deleted file mode 100644 index 310962f3a00bebadb68c8744c57b18bfe6ce9a36..0000000000000000000000000000000000000000 --- a/timing/time_zgetrs_incpiv_tile.c +++ /dev/null @@ -1,91 +0,0 @@ -/** - * - * @file time_zgetrs_incpiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-07-28 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrs_incpiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRS( N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAM_desc_t *descL; - int *piv; - PASTE_CODE_IPARAM_LOCALS( iparam ); - check = 1; - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile(descA, 3456); - - /* Allocate Workspace */ - CHAMELEON_Alloc_Workspace_zgesv_incpiv_Tile(chameleon_min(M,N), &descL, &piv, P, Q); - - /* Save A for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - /* CHAMELEON ZGETRF_NOPIV */ - CHAMELEON_zgetrf_incpiv_Tile( descA, descL, piv ); - - /* Check the solution */ - if ( check ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 7732 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - START_TIMING(); - CHAMELEON_zgetrs_incpiv_Tile( descA, descL, piv, descX ); - STOP_TIMING(); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - /* Deallocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descL); - - PASTE_CODE_FREE_MATRIX( descA ); - free( piv ); - - return 0; -} diff --git a/timing/time_zgetrs_nopiv_tile.c b/timing/time_zgetrs_nopiv_tile.c deleted file mode 100644 index 4ebcfbd278afbd6983d58102f77a43e17c5deb0f..0000000000000000000000000000000000000000 --- a/timing/time_zgetrs_nopiv_tile.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zgetrs_nopiv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-07-28 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zgetrs_nopiv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_GETRS( N, NRHS )) -#define _FADDS (FADDS_GETRS( N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - check = 1; - - if ( M != N && check ) { - fprintf(stderr, "Check cannot be perfomed with M != N\n"); - check = 0; - } - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, NRHS ); - - CHAMELEON_zplrnt_Tile(descA, 3456); - - /* Save A for check */ - if (check == 1){ - CHAMELEON_zlacpy_Tile(ChamUpperLower, descA, descAC); - } - - /* CHAMELEON ZGETRF_NOPIV */ - CHAMELEON_zgetrf_nopiv_Tile( descA ); - - /* Check the solution */ - if ( check ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descX, 7732 ); - CHAMELEON_zlacpy_Tile(ChamUpperLower, descX, descB); - - /* Compute the solution */ - START_TIMING(); - CHAMELEON_zgetrs_nopiv_Tile( descA, descX ); - STOP_TIMING(); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descAC); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile(ChamInfNorm, descX); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile(ChamInfNorm, descB); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - - return 0; -} diff --git a/timing/time_zheevd_tile.c b/timing/time_zheevd_tile.c deleted file mode 100644 index 74bfd566211061172bb6cd2470993094d44ae49c..0000000000000000000000000000000000000000 --- a/timing/time_zheevd_tile.c +++ /dev/null @@ -1,63 +0,0 @@ -/** - * - * @file time_zheevd_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2016-12-09 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zheevd_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS ((2. / 3.) * ((double)N * (double)N * (double)N)) -#define _FADDS ((2. / 3.) * ((double)N * (double)N * (double)N)) - -#include "./timing.c" -/* #include <mkl_service.h> */ - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - CHAM_desc_t *descT; - cham_uplo_t uplo = ChamLower; - int vec = ChamVec; - int INFO; - - LDA = chameleon_max(LDA, N); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N); - PASTE_CODE_ALLOCATE_MATRIX( S, 1, double, N, 1 ); - - /* Allocate Workspace */ - CHAMELEON_zplghe( (double)N, uplo, N, A, LDA, 51 ); - CHAMELEON_Alloc_Workspace_zheevd(N, N, &descT, 1, 1); - - START_TIMING(); - INFO = CHAMELEON_zheevd(vec, uplo, N, A, LDA, S, descT); - STOP_TIMING(); - - if (INFO != 0){ - printf(" ERROR OCCURED INFO %d\n", INFO); - } - - /* DeAllocate Workspace */ - CHAMELEON_Dealloc_Workspace(&descT); - - free( A ); - (void)dparam; - return 0; -} diff --git a/timing/time_zhemm_tile.c b/timing/time_zhemm_tile.c deleted file mode 100644 index 04c16208a2745494de2e9aa2abf84e4194a16d74..0000000000000000000000000000000000000000 --- a/timing/time_zhemm_tile.c +++ /dev/null @@ -1,87 +0,0 @@ -/** - * - * @file time_zhemm_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zhemm_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_HEMM( ChamLeft, M, N ) -#define _FADDS FADDS_HEMM( ChamLeft, M, N ) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAMELEON_Complex64_t alpha, beta; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - LDA = chameleon_max(M, iparam[IPARAM_LDA]); - LDB = chameleon_max(M, iparam[IPARAM_LDB]); - LDC = chameleon_max(M, iparam[IPARAM_LDC]); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, M ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descC, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDC, M, N ); - - /* Initialize Data */ - CHAMELEON_zplghe_Tile( 0, ChamUpper, descA, 5373 ); - CHAMELEON_zplrnt_Tile( descB, 7672 ); - CHAMELEON_zplrnt_Tile( descC, 6387 ); - -#if !defined(CHAMELEON_SIMULATION) - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha); - LAPACKE_zlarnv_work(1, ISEED, 1, &beta); -#else - alpha = 1.5; - beta = -2.3; -#endif - - /* Save C for check */ - PASTE_TILE_TO_LAPACK( descC, C2, check, CHAMELEON_Complex64_t, LDC, N ); - - START_TIMING(); - CHAMELEON_zhemm_Tile( ChamLeft, ChamUpper, alpha, descA, descB, beta, descC ); - STOP_TIMING(); - -#if !defined(CHAMELEON_SIMULATION) - /* Check the solution */ - if (check) - { - PASTE_TILE_TO_LAPACK( descA, A, check, CHAMELEON_Complex64_t, LDA, M ); - PASTE_TILE_TO_LAPACK( descB, B, check, CHAMELEON_Complex64_t, LDB, N ); - PASTE_TILE_TO_LAPACK( descC, C, check, CHAMELEON_Complex64_t, LDC, N ); - - dparam[IPARAM_RES] = z_check_hemm( ChamLeft, ChamUpper, M, N, - alpha, A, LDA, B, LDB, beta, C, C2, LDC, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM]) ); - - free(A); free(B); free(C); free(C2); - } -#endif - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descB ); - PASTE_CODE_FREE_MATRIX( descC ); - return 0; -} diff --git a/timing/time_zlange.c b/timing/time_zlange.c deleted file mode 100644 index feed6be11b5b15f33f1cf4f98f2b91c5022946b8..0000000000000000000000000000000000000000 --- a/timing/time_zlange.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zlange.c - * - * @Copyright 2009-2014 The University of Tennessee and The University - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zlange" -#define _FMULS FMULS_LANGE(M, N) -#define _FADDS FADDS_LANGE(M, N) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - int hres = 0; - double normcham, normlapack, result; - int norm = ChamInfNorm; - - PASTE_CODE_IPARAM_LOCALS( iparam ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, M, N ); - - CHAMELEON_zplrnt( M, N, A, LDA, 3436 ); - - /* CHAMELEON ZLANGE */ - START_TIMING(); - normcham = CHAMELEON_zlange(norm, M, N, A, LDA); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - double *work = (double*) malloc(chameleon_max(M,N)*sizeof(double)); - normlapack = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm), M, N, A, LDA, work); - result = fabs(normcham - normlapack); - switch(norm) { - case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; - break; - case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; - break; - case ChamFrobeniusNorm: - /* Sum oreder on every element can differ */ - result = result / ((double)M * (double)N); - break; - } - if ( CHAMELEON_Comm_rank() == 0 ) { - dparam[IPARAM_ANORM] = normlapack; - dparam[IPARAM_BNORM] = 0.; - dparam[IPARAM_XNORM] = 1.; - dparam[IPARAM_RES] = result; - } - free( work ); - } - - free( A ); - - return hres; -} diff --git a/timing/time_zlange_tile.c b/timing/time_zlange_tile.c deleted file mode 100644 index 1a5888e3798a89bf2fe83c6f185bbfde6e39f740..0000000000000000000000000000000000000000 --- a/timing/time_zlange_tile.c +++ /dev/null @@ -1,88 +0,0 @@ -/** - * - * @file time_zlange_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zlange_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_LANGE(M, N) -#define _FADDS FADDS_LANGE(M, N) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - double normcham; - int norm = ChamInfNorm; - - PASTE_CODE_IPARAM_LOCALS( iparam ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, N ); - CHAMELEON_zplrnt_Tile( descA, 3436 ); - - /* CHAMELEON ZPOSV */ - START_TIMING(); - normcham = CHAMELEON_zlange_Tile(norm, descA); - STOP_TIMING(); - -#if !defined(CHAMELEON_SIMULATION) - /* Check the solution */ - if ( check ) - { - double normlapack, result; - - /* Allocate Data */ - PASTE_TILE_TO_LAPACK( descA, A, check, CHAMELEON_Complex64_t, M, N ); - double *work = (double*) malloc(chameleon_max(M,N)*sizeof(double)); - normlapack = LAPACKE_zlange_work(LAPACK_COL_MAJOR, chameleon_lapack_const(norm), M, N, A, LDA, work); - result = fabs(normcham - normlapack); - switch(norm) { - case ChamMaxNorm: - /* result should be perfectly equal */ - break; - case ChamInfNorm: - /* Sum order on the line can differ */ - result = result / (double)N; - break; - case ChamOneNorm: - /* Sum order on the column can differ */ - result = result / (double)M; - break; - case ChamFrobeniusNorm: - /* Sum oreder on every element can differ */ - result = result / ((double)M * (double)N); - break; - } - if ( CHAMELEON_Comm_rank() == 0 ) { - dparam[IPARAM_ANORM] = normlapack; - dparam[IPARAM_BNORM] = 0.; - dparam[IPARAM_XNORM] = 1.; - dparam[IPARAM_RES] = result; - } - free( work ); - free( A ); - } -#endif - - PASTE_CODE_FREE_MATRIX( descA ); - (void)normcham; - return 0; -} diff --git a/timing/time_zposv.c b/timing/time_zposv.c deleted file mode 100644 index 5ca0f40fe173edd57a4847f83c13007ff21a91ae..0000000000000000000000000000000000000000 --- a/timing/time_zposv.c +++ /dev/null @@ -1,73 +0,0 @@ -/** - * - * @file time_zposv.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zposv" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_POTRF( N ) + FMULS_POTRS( N, NRHS )) -#define _FADDS (FADDS_POTRF( N ) + FADDS_POTRS( N, NRHS )) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamUpper; - - LDA = chameleon_max(LDA, N); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( A2, check, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( X, 1, CHAMELEON_Complex64_t, LDB, NRHS ); - - /* Initialize data and save A if check */ - if ( check ) { - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A2, LDA, 51 ); - CHAMELEON_zlacpy( uplo, N, N, A2, LDA, A, LDA ); - } - else { - CHAMELEON_zplghe( (double)N, uplo, N, A, LDA, 51 ); - } - CHAMELEON_zplrnt( N, NRHS, X, LDB, 5673 ); - - /* Save b */ - PASTE_CODE_ALLOCATE_COPY( B, check, CHAMELEON_Complex64_t, X, LDB, NRHS ); - - /* CHAMELEON ZPOSV */ - START_TIMING(); - CHAMELEON_zposv( uplo, N, NRHS, A, LDA, X, LDB ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_RES] = z_check_solution( N, N, NRHS, A2, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM]) ); - free(A2); free(B); - } - - free(A); free(X); - return 0; -} diff --git a/timing/time_zposv_tile.c b/timing/time_zposv_tile.c deleted file mode 100644 index 2f032d5a36e2d8f9a72b579ef146f110caad86f3..0000000000000000000000000000000000000000 --- a/timing/time_zposv_tile.c +++ /dev/null @@ -1,78 +0,0 @@ -/** - * - * @file time_zposv_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zposv_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_POTRF( N ) + FMULS_POTRS( N, NRHS )) -#define _FADDS (FADDS_POTRF( N ) + FADDS_POTRS( N, NRHS )) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamUpper; - - LDA = chameleon_max(LDA, N); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - - /* Initialize data and save A and B if check */ - CHAMELEON_zplrnt_Tile( descX, 7672 ); - if ( check ) { - CHAMELEON_zplghe_Tile( (double)N, ChamUpperLower, descAC, 51 ); - CHAMELEON_zlacpy_Tile( uplo, descAC, descA ); - - CHAMELEON_zlacpy_Tile( ChamUpperLower, descX, descB ); - } - else { - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, 51 ); - } - - /* CHAMELEON ZPOSV */ - START_TIMING(); - CHAMELEON_zposv_Tile( uplo, descA, descX ); - STOP_TIMING(); - - /* Check the solution */ - if (check) - { - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descAC ); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descX ); - - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descB ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descX ); - return 0; -} diff --git a/timing/time_zpotrf.c b/timing/time_zpotrf.c deleted file mode 100644 index 78900b1f423e92bca2f86aaea7e086d44eaa0905..0000000000000000000000000000000000000000 --- a/timing/time_zpotrf.c +++ /dev/null @@ -1,75 +0,0 @@ -/** - * - * @file time_zpotrf.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverges - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zpotrf" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_POTRF( N ) -#define _FADDS FADDS_POTRF( N ) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamLower; - - LDA = chameleon_max( LDA, N ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( A2, check, CHAMELEON_Complex64_t, LDA, N ); - - /* Initialize data and save A if check */ - if ( check ) { - CHAMELEON_zplghe( (double)N, ChamUpperLower, N, A2, LDA, 51 ); - CHAMELEON_zlacpy( uplo, N, N, A2, LDA, A, LDA ); - } - else { - CHAMELEON_zplghe( (double)N, uplo, N, A, LDA, 51 ); - } - - /* CHAMELEON ZPOSV */ - START_TIMING(); - CHAMELEON_zpotrf( uplo, N, A, LDA ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - PASTE_CODE_ALLOCATE_MATRIX( B, check, CHAMELEON_Complex64_t, LDB, NRHS ); - CHAMELEON_zplrnt( N, NRHS, B, LDB, 5673 ); - PASTE_CODE_ALLOCATE_COPY( X, check, CHAMELEON_Complex64_t, B, LDB, NRHS ); - - CHAMELEON_zpotrs(uplo, N, NRHS, A, LDA, X, LDB); - - dparam[IPARAM_RES] = z_check_solution( N, N, NRHS, A2, LDA, B, X, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM]) ); - - free(A2); free(B); free(X); - } - - free(A); - return 0; -} diff --git a/timing/time_zpotrf_tile.c b/timing/time_zpotrf_tile.c deleted file mode 100644 index 9799baeedc9e992f90da0ba2ac0d9b61e7a44780..0000000000000000000000000000000000000000 --- a/timing/time_zpotrf_tile.c +++ /dev/null @@ -1,83 +0,0 @@ -/** - * - * @file time_zpotrf_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zpotrf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_POTRF( N ) -#define _FADDS FADDS_POTRF( N ) - -#include "./timing.c" - -static int -RunTest( int *iparam, double *dparam, chameleon_time_t *t_ ) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamUpper; - - LDA = chameleon_max( LDA, N ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - - /* Initialize data and save A if check */ - if ( check ) { - CHAMELEON_zplghe_Tile( (double)N, ChamUpperLower, descAC, 51 ); - CHAMELEON_zlacpy_Tile( uplo, descAC, descA ); - } - else { - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, 51 ); - } - //RUNTIME_zlocality_allrestrict( STARPU_CUDA ); - - /* CHAMELEON ZPOTRF */ - START_TIMING(); - CHAMELEON_zpotrf_Tile( uplo, descA ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - /* Initialize and save B */ - CHAMELEON_zplrnt_Tile( descB, 7672 ); - CHAMELEON_zlacpy_Tile( ChamUpperLower, descB, descX ); - - /* Compute the solution */ - CHAMELEON_zpotrs_Tile( uplo, descA, descX ); - - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descAC ); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descX ); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - - PASTE_CODE_FREE_MATRIX( descB ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descX ); - - } - PASTE_CODE_FREE_MATRIX( descA ); - - return 0; -} diff --git a/timing/time_zpotri_tile.c b/timing/time_zpotri_tile.c deleted file mode 100644 index 97f7097388bcb752d2a2af90db3f36d4377336b4..0000000000000000000000000000000000000000 --- a/timing/time_zpotri_tile.c +++ /dev/null @@ -1,137 +0,0 @@ -/** - * - * @file time_zpotri_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zpotri_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS (FMULS_POTRF( N ) + FMULS_POTRI( N )) -#define _FADDS (FADDS_POTRF( N ) + FADDS_POTRI( N )) - -//#define POTRI_SYNC - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamLower; - - LDA = chameleon_max(LDA, N); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - - /* - * Initialize Data - * It's done in static to avoid having the same sequence than one - * the function we want to trace - */ - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, 51 ); - - /* CHAMELEON ZPOTRF / ZTRTRI / ZLAUUM */ - /* - * Example of the different way to combine several asynchonous calls - */ -#if defined(TRACE_BY_SEQUENCE) - { - RUNTIME_sequence_t *sequence; - RUNTIME_request_t request[3] = { RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER }; - - CHAMELEON_Sequence_Create(&sequence); - - if ( ! iparam[IPARAM_ASYNC] ) { - START_TIMING(); - - CHAMELEON_zpotrf_Tile_Async(uplo, descA, sequence, &request[0]); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - - CHAMELEON_ztrtri_Tile_Async(uplo, ChamNonUnit, descA, sequence, &request[1]); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - - CHAMELEON_zlauum_Tile_Async(uplo, descA, sequence, &request[2]); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - - STOP_TIMING(); - - } else { - - START_TIMING(); - CHAMELEON_zpotrf_Tile_Async(uplo, descA, sequence, &request[0]); - CHAMELEON_ztrtri_Tile_Async(uplo, ChamNonUnit, descA, sequence, &request[1]); - CHAMELEON_zlauum_Tile_Async(uplo, descA, sequence, &request[2]); - - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - STOP_TIMING(); - } - - CHAMELEON_Sequence_Destroy(sequence[0]); - CHAMELEON_Sequence_Destroy(sequence[1]); - CHAMELEON_Sequence_Destroy(sequence[2]); - } -#else - { - if ( ! iparam[IPARAM_ASYNC] ) { - - START_TIMING(); - CHAMELEON_zpotrf_Tile(uplo, descA); - CHAMELEON_ztrtri_Tile(uplo, ChamNonUnit, descA); - CHAMELEON_zlauum_Tile(uplo, descA); - STOP_TIMING(); - - } else { - - /* Default: we use Asynchonous call with only one sequence */ - RUNTIME_sequence_t *sequence; - RUNTIME_request_t request[2] = { RUNTIME_REQUEST_INITIALIZER, - RUNTIME_REQUEST_INITIALIZER }; - - START_TIMING(); - CHAMELEON_Sequence_Create(&sequence); - CHAMELEON_zpotrf_Tile_Async(uplo, descA, sequence, &request[0]); - CHAMELEON_zpotri_Tile_Async(uplo, descA, sequence, &request[1]); - CHAMELEON_Desc_Flush( descA, sequence ); - CHAMELEON_Sequence_Wait(sequence); - STOP_TIMING(); - - CHAMELEON_Sequence_Destroy(sequence); - } - } -#endif - - /* Check the solution */ - if ( check ) - { - dparam[IPARAM_ANORM] = 0.0; - dparam[IPARAM_XNORM] = 0.0; - dparam[IPARAM_BNORM] = 0.0; - dparam[IPARAM_RES] = 0.0; - } - - PASTE_CODE_FREE_MATRIX( descA ); - - return 0; -} diff --git a/timing/time_zpotrs_tile.c b/timing/time_zpotrs_tile.c deleted file mode 100644 index f937d48340fffda4f8719ef1c8e0e69729f99fb5..0000000000000000000000000000000000000000 --- a/timing/time_zpotrs_tile.c +++ /dev/null @@ -1,82 +0,0 @@ -/** - * - * @file time_zpotrs_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-07-28 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zpotrs_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_POTRS( N, NRHS ) -#define _FADDS FADDS_POTRS( N, NRHS ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamUpper; - - LDA = chameleon_max( LDA, N ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - - /* Initialize data and save A and B if check */ - CHAMELEON_zplrnt_Tile( descX, 7672 ); - if ( check ) { - CHAMELEON_zplghe_Tile( (double)N, ChamUpperLower, descAC, 51 ); - CHAMELEON_zlacpy_Tile( uplo, descAC, descA ); - - CHAMELEON_zlacpy_Tile( ChamUpperLower, descX, descB ); - } - else { - CHAMELEON_zplghe_Tile( (double)N, uplo, descA, 51 ); - } - //RUNTIME_zlocality_allrestrict( STARPU_CUDA ); - - /* CHAMELEON ZPOTRF */ - CHAMELEON_zpotrf_Tile(uplo, descA); - - /* Compute the solution */ - START_TIMING(); - CHAMELEON_zpotrs_Tile( uplo, descA, descX ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - /* Check solution */ - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descAC ); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descX ); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - - PASTE_CODE_FREE_MATRIX( descAC ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descX ); - PASTE_CODE_FREE_MATRIX( descB ); - - return 0; -} diff --git a/timing/time_zsymm_tile.c b/timing/time_zsymm_tile.c deleted file mode 100644 index 0675e238c999f94e1dc902caded132415e059a6d..0000000000000000000000000000000000000000 --- a/timing/time_zsymm_tile.c +++ /dev/null @@ -1,87 +0,0 @@ -/** - * - * @file time_zsymm_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zsymm_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_SYMM( ChamLeft, M, N ) -#define _FADDS FADDS_SYMM( ChamLeft, M, N ) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAMELEON_Complex64_t alpha, beta; - PASTE_CODE_IPARAM_LOCALS( iparam ); - - LDA = chameleon_max(M, iparam[IPARAM_LDA]); - LDB = chameleon_max(M, iparam[IPARAM_LDB]); - LDC = chameleon_max(M, iparam[IPARAM_LDC]); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, M, M ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, M, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descC, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDC, M, N ); - - /* Initialize Data */ - CHAMELEON_zplghe_Tile( 0, ChamUpper, descA, 5373 ); - CHAMELEON_zplrnt_Tile( descB, 7672 ); - CHAMELEON_zplrnt_Tile( descC, 6387 ); - -#if !defined(CHAMELEON_SIMULATION) - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha); - LAPACKE_zlarnv_work(1, ISEED, 1, &beta); -#else - alpha = 1.5; - beta = -2.3; -#endif - - /* Save C for check */ - PASTE_TILE_TO_LAPACK( descC, C2, check, CHAMELEON_Complex64_t, LDC, N ); - - START_TIMING(); - CHAMELEON_zsymm_Tile( ChamLeft, ChamUpper, alpha, descA, descB, beta, descC ); - STOP_TIMING(); - -#if !defined(CHAMELEON_SIMULATION) - /* Check the solution */ - if (check) - { - PASTE_TILE_TO_LAPACK( descA, A, check, CHAMELEON_Complex64_t, LDA, M ); - PASTE_TILE_TO_LAPACK( descB, B, check, CHAMELEON_Complex64_t, LDB, N ); - PASTE_TILE_TO_LAPACK( descC, C, check, CHAMELEON_Complex64_t, LDC, N ); - - dparam[IPARAM_RES] = z_check_symm( ChamLeft, ChamUpper, M, N, - alpha, A, LDA, B, LDB, beta, C, C2, LDC, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM]) ); - - free(A); free(B); free(C); free(C2); - } -#endif - - PASTE_CODE_FREE_MATRIX( descA ); - PASTE_CODE_FREE_MATRIX( descB ); - PASTE_CODE_FREE_MATRIX( descC ); - return 0; -} diff --git a/timing/time_zsytrf_tile.c b/timing/time_zsytrf_tile.c deleted file mode 100644 index 38c3d1c5b8852d9ea7215fb03f96c4f286e3d73f..0000000000000000000000000000000000000000 --- a/timing/time_zsytrf_tile.c +++ /dev/null @@ -1,76 +0,0 @@ -/** - * - * @file time_zsytrf_tile.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_zsytrf_Tile" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_SYTRF( N ) -#define _FADDS FADDS_SYTRF( N ) - -#include "./timing.c" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - PASTE_CODE_IPARAM_LOCALS( iparam ); - cham_uplo_t uplo = ChamUpper; - - LDA = chameleon_max(LDA, N); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX_TILE( descA, 1, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descB, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descAC, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDA, N, N ); - PASTE_CODE_ALLOCATE_MATRIX_TILE( descX, check, CHAMELEON_Complex64_t, ChamComplexDouble, LDB, N, NRHS ); - - /* Initialize data and save A if check */ - if ( check ) { - CHAMELEON_zplgsy_Tile( (double)N, ChamUpperLower, descAC, 51 ); - CHAMELEON_zlacpy_Tile( uplo, descAC, descA ); - } - else { - CHAMELEON_zplgsy_Tile( (double)N, uplo, descA, 51 ); - } - - /* CHAMELEON ZSYSV */ - START_TIMING(); - CHAMELEON_zsytrf_Tile( uplo, descA ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - CHAMELEON_zplrnt_Tile( descB, 7672 ); - CHAMELEON_zlacpy_Tile( ChamUpperLower, descB, descX ); - CHAMELEON_zsytrs_Tile( uplo, descA, descX ); - dparam[IPARAM_ANORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descAC ); - dparam[IPARAM_BNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - dparam[IPARAM_XNORM] = CHAMELEON_zlange_Tile( ChamInfNorm, descX ); - CHAMELEON_zgemm_Tile( ChamNoTrans, ChamNoTrans, 1.0, descAC, descX, -1.0, descB ); - dparam[IPARAM_RES] = CHAMELEON_zlange_Tile( ChamInfNorm, descB ); - - PASTE_CODE_FREE_MATRIX( descB ); - PASTE_CODE_FREE_MATRIX( descAC ); - PASTE_CODE_FREE_MATRIX( descX ); - } - - PASTE_CODE_FREE_MATRIX( descA ); - return 0; -} diff --git a/timing/time_ztrsm.c b/timing/time_ztrsm.c deleted file mode 100644 index 12e488196b1425eae26dbc512bafa26dfe9f540e..0000000000000000000000000000000000000000 --- a/timing/time_ztrsm.c +++ /dev/null @@ -1,75 +0,0 @@ -/** - * - * @file time_ztrsm.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * @precisions normal z -> c d s - * - */ -#define _TYPE CHAMELEON_Complex64_t -#define _PREC double -#define _LAMCH LAPACKE_dlamch_work - -#define _NAME "CHAMELEON_ztrsm" -/* See Lawn 41 page 120 */ -#define _FMULS FMULS_TRSM( ChamLeft, N, NRHS ) -#define _FADDS FADDS_TRSM( ChamLeft, N, NRHS ) - -#include "./timing.c" -#include "timing_zauxiliary.h" - -static int -RunTest(int *iparam, double *dparam, chameleon_time_t *t_) -{ - CHAMELEON_Complex64_t alpha; - cham_uplo_t uplo = ChamLower; - - PASTE_CODE_IPARAM_LOCALS( iparam ); - - LDA = chameleon_max( LDA, N ); - - /* Allocate Data */ - PASTE_CODE_ALLOCATE_MATRIX( A, 1, CHAMELEON_Complex64_t, LDA, N ); - PASTE_CODE_ALLOCATE_MATRIX( B, 1, CHAMELEON_Complex64_t, LDB, NRHS); - PASTE_CODE_ALLOCATE_MATRIX( B2, check, CHAMELEON_Complex64_t, LDB, NRHS); - - /* Initialize Data */ - CHAMELEON_zplgsy( (CHAMELEON_Complex64_t)N, uplo, N, A, LDA, 453 ); - CHAMELEON_zplrnt( N, NRHS, B, LDB, 5673 ); - LAPACKE_zlarnv_work(1, ISEED, 1, &alpha); - alpha = 10.; /*alpha * N / 2.;*/ - - if ( check ) { - memcpy(B2, B, LDB*NRHS*sizeof(CHAMELEON_Complex64_t)); - } - - START_TIMING(); - CHAMELEON_ztrsm( ChamLeft, uplo, ChamNoTrans, ChamUnit, - N, NRHS, alpha, A, LDA, B, LDB ); - STOP_TIMING(); - - /* Check the solution */ - if ( check ) - { - dparam[IPARAM_RES] = z_check_trsm( ChamLeft, uplo, ChamNoTrans, ChamUnit, - N, NRHS, - alpha, A, LDA, B, B2, LDB, - &(dparam[IPARAM_ANORM]), - &(dparam[IPARAM_BNORM]), - &(dparam[IPARAM_XNORM])); - free(B2); - } - - free( A ); - free( B ); - return 0; -} diff --git a/timing/timing.c b/timing/timing.c deleted file mode 100644 index 953b18ebdc9b05f2445b5239c1a01f330c4e2aaf..0000000000000000000000000000000000000000 --- a/timing/timing.c +++ /dev/null @@ -1,758 +0,0 @@ -/** - * - * @file timing.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @brief Chameleon auxiliary routines - * - * @version 0.9.2 - * @author Mathieu Faverge - * @author Raphael Boucherie - * @author Dulceneia Becker - * @author Cedric Castagnede - * @date 2014-11-16 - * - */ -#if defined( _WIN32 ) || defined( _WIN64 ) -#define int64_t __int64 -#endif - -/* Define these so that the Microsoft VC compiler stops complaining - about scanf and friends */ -#define _CRT_SECURE_NO_DEPRECATE -#define _CRT_SECURE_NO_WARNINGS - -#include <math.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <limits.h> - -#if defined( _WIN32 ) || defined( _WIN64 ) -#include <windows.h> -#else /* Non-Windows */ -#include <unistd.h> -#include <sys/resource.h> -#endif - -#include <chameleon.h> -#if !defined(CHAMELEON_SIMULATION) -#include <coreblas/lapacke.h> -#include <coreblas.h> -#endif -#include "flops.h" -#include "timing.h" -#include "control/auxiliary.h" - -#if defined(CHAMELEON_USE_MPI) -#include <mpi.h> -#endif /* defined(CHAMELEON_USE_MPI */ - -#if defined(CHAMELEON_SCHED_STARPU) -#include <starpu.h> -#endif /* defined(CHAMELEON_SCHED_STARPU) */ - -#if defined(CHAMELEON_HAVE_GETOPT_H) -#include <getopt.h> -#endif /* defined(CHAMELEON_HAVE_GETOPT_H) */ - -static int RunTest(int *iparam, _PREC *dparam, double *t_); -static inline void* chameleon_getaddr_null(const CHAM_desc_t *A, int m, int n) -{ - (void)A;(void)m;(void)n; - return (void*)( NULL ); -} - -int ISEED[4] = {0,0,0,1}; /* initial seed for zlarnv() */ - -static int -Test(int64_t n, int *iparam) { - int i, j, iter; - int thrdnbr, niter; - int64_t M, N, K, NRHS; - double *t; -#if defined(CHAMELEON_SIMULATION) - _PREC eps = 0.; -#else - _PREC eps = _LAMCH( 'e' ); -#endif - _PREC dparam[IPARAM_DNBPARAM]; - double fmuls, fadds, fp_per_mul, fp_per_add; - double sumgf, sumgf2, sumt, sd, flops, gflops; - char *s; - char *env[] = { - "OMP_NUM_THREADS", - "MKL_NUM_THREADS", - "GOTO_NUM_THREADS", - "ACML_NUM_THREADS", - "ATLAS_NUM_THREADS", - "BLAS_NUM_THREADS", "" - }; - int gnuplot = 0; - -/* - * if hres = 0 then the test succeed - * if hres = n then the test failed n times - */ - int hres = 0; - - memset( &dparam, 0, IPARAM_DNBPARAM * sizeof(_PREC) ); - dparam[IPARAM_THRESHOLD_CHECK] = 100.0; - - thrdnbr = iparam[IPARAM_THRDNBR]; - niter = iparam[IPARAM_NITER]; - - M = iparam[IPARAM_M]; - N = iparam[IPARAM_N]; - K = iparam[IPARAM_K]; - NRHS = K; - (void)M;(void)N;(void)K;(void)NRHS; - - if ( (n < 0) || (thrdnbr < 0 ) ) { - if (gnuplot && (CHAMELEON_Comm_rank() == 0) ) { - printf( "set title '%d_NUM_THREADS: ", thrdnbr ); - for (i = 0; env[i][0]; ++i) { - s = getenv( env[i] ); - - if (i) printf( " " ); /* separating space */ - - for (j = 0; j < 5 && env[i][j] && env[i][j] != '_'; ++j) - printf( "%c", env[i][j] ); - - if (s) - printf( "=%s", s ); - else - printf( "->%s", "?" ); - } - printf( "'\n" ); - printf( "%s\n%s\n%s\n%s\n%s%s%s\n", - "set xlabel 'Matrix size'", - "set ylabel 'Gflop/s'", - "set key bottom", - gnuplot > 1 ? "set terminal png giant\nset output 'timeplot.png'" : "", - "plot '-' using 1:5 title '", _NAME, "' with linespoints" ); - } - return 0; - } - - if ( CHAMELEON_Comm_rank() == 0) - printf( "%7d %7d %7d ", iparam[IPARAM_M], iparam[IPARAM_N], iparam[IPARAM_K] ); - fflush( stdout ); - - t = (double*)malloc(niter*sizeof(double)); - memset(t, 0, niter*sizeof(double)); - - if (sizeof(_TYPE) == sizeof(_PREC)) { - fp_per_mul = 1; - fp_per_add = 1; - } else { - fp_per_mul = 6; - fp_per_add = 2; - } - - fadds = (double)(_FADDS); - fmuls = (double)(_FMULS); - flops = 1e-9 * (fmuls * fp_per_mul + fadds * fp_per_add); - - if ( iparam[IPARAM_WARMUP] ) { - int status = RunTest( iparam, dparam, &(t[0])); - if (status != CHAMELEON_SUCCESS) { - free(t); - return status; - } - } - - sumgf = 0.0; - double sumgf_upper = 0.0; - sumgf2 = 0.0; - sumt = 0.0; - - for (iter = 0; iter < niter; iter++) - { - if( iter == 0 ) { - if ( iparam[IPARAM_TRACE] ) - iparam[IPARAM_TRACE] = 2; - if ( iparam[IPARAM_DAG] ) - iparam[IPARAM_DAG] = 2; - if ( iparam[IPARAM_PROFILE] ) - iparam[IPARAM_PROFILE] = 2; - - int status = RunTest( iparam, dparam, &(t[iter])); - if (status != CHAMELEON_SUCCESS) return status; - - iparam[IPARAM_TRACE] = 0; - iparam[IPARAM_DAG] = 0; - iparam[IPARAM_PROFILE] = 0; - } - else { - int status = RunTest( iparam, dparam, &(t[iter])); - if (status != CHAMELEON_SUCCESS) return status; - } - gflops = flops / t[iter]; - -#if defined (CHAMELEON_SCHED_STARPU) - /* TODO: create chameleon interface encapsulating this instead */ - if (iparam[IPARAM_BOUND]) - { - double upper_gflops = 0.0; - double tmin = 0.0; - double integer_tmin = 0.0; - starpu_bound_compute(&tmin, &integer_tmin, 0); - upper_gflops = (flops / (tmin / 1000.0)); - sumgf_upper += upper_gflops; - } -#endif - sumt += t[iter]; - sumgf += gflops; - sumgf2 += gflops*gflops; - } - - gflops = sumgf / niter; - sd = sqrt((sumgf2 - (sumgf*sumgf)/niter)/niter); - - if ( CHAMELEON_Comm_rank() == 0) { - printf( "%9.3f %9.2f +-%7.2f ", sumt/niter, gflops, sd); - - if (iparam[IPARAM_BOUND]) { - printf(" %9.2f", sumgf_upper/niter); - } - - if ( iparam[IPARAM_CHECK] ){ - hres = ( dparam[IPARAM_RES] / n / eps / (dparam[IPARAM_ANORM] * dparam[IPARAM_XNORM] + dparam[IPARAM_BNORM] ) > dparam[IPARAM_THRESHOLD_CHECK] ); - - if (hres) { - printf( "%8.5e %8.5e %8.5e %8.5e %8.5e FAILURE", - dparam[IPARAM_RES], dparam[IPARAM_ANORM], dparam[IPARAM_XNORM], dparam[IPARAM_BNORM], - dparam[IPARAM_RES] / n / eps / (dparam[IPARAM_ANORM] * dparam[IPARAM_XNORM] + dparam[IPARAM_BNORM] )); - } - else { - printf( "%8.5e %8.5e %8.5e %8.5e %8.5e SUCCESS", - dparam[IPARAM_RES], dparam[IPARAM_ANORM], dparam[IPARAM_XNORM], dparam[IPARAM_BNORM], - dparam[IPARAM_RES] / n / eps / (dparam[IPARAM_ANORM] * dparam[IPARAM_XNORM] + dparam[IPARAM_BNORM] )); - } - } - - if ( iparam[IPARAM_INVERSE] ) { - printf( " %8.5e %8.5e %8.5e %8.5e", - dparam[IPARAM_RNORM], dparam[IPARAM_ANORM], dparam[IPARAM_AinvNORM], - dparam[IPARAM_RNORM] /((dparam[IPARAM_ANORM] * dparam[IPARAM_AinvNORM])*n*eps)); - } - - printf("\n"); - - fflush( stdout ); - } - free(t); - - return hres; -} - -static inline int -startswith(const char *s, const char *prefix) { - size_t n = strlen( prefix ); - if (strncmp( s, prefix, n )) - return 0; - return 1; -} - -static int -get_range(char *range, int *start_p, int *stop_p, int *step_p) { - char *s, *s1, buf[21]; - int colon_count, copy_len, nbuf=20, n; - int start=1000, stop=10000, step=1000; - - colon_count = 0; - for (s = strchr( range, ':'); s; s = strchr( s+1, ':')) - colon_count++; - - if (colon_count == 0) { /* No colon in range. */ - if (sscanf( range, "%d", &start ) < 1 || start < 1) - return -1; - step = start / 10; - if (step < 1) step = 1; - stop = start + 10 * step; - - } else if (colon_count == 1) { /* One colon in range.*/ - /* First, get the second number (after colon): the stop value. */ - s = strchr( range, ':' ); - if (sscanf( s+1, "%d", &stop ) < 1 || stop < 1) - return -1; - - /* Next, get the first number (before colon): the start value. */ - n = s - range; - copy_len = n > nbuf ? nbuf : n; - strncpy( buf, range, copy_len ); - buf[copy_len] = 0; - if (sscanf( buf, "%d", &start ) < 1 || start > stop || start < 1) - return -1; - - /* Let's have 10 steps or less. */ - step = (stop - start) / 10; - if (step < 1) - step = 1; - } else if (colon_count == 2) { /* Two colons in range. */ - /* First, get the first number (before the first colon): the start value. */ - s = strchr( range, ':' ); - n = s - range; - copy_len = n > nbuf ? nbuf : n; - strncpy( buf, range, copy_len ); - buf[copy_len] = 0; - if (sscanf( buf, "%d", &start ) < 1 || start < 1) - return -1; - - /* Next, get the second number (after the first colon): the stop value. */ - s1 = strchr( s+1, ':' ); - n = s1 - (s + 1); - copy_len = n > nbuf ? nbuf : n; - strncpy( buf, s+1, copy_len ); - buf[copy_len] = 0; - if (sscanf( buf, "%d", &stop ) < 1 || stop < start) - return -1; - - /* Finally, get the third number (after the second colon): the step value. */ - if (sscanf( s1+1, "%d", &step ) < 1 || step < 1) - return -1; - } else - - return -1; - - *start_p = start; - *stop_p = stop; - *step_p = step; - - return 0; -} - -static void -show_help(char *prog_name) { - printf( "Usage:\n%s [options]\n\n", prog_name ); - printf( "Options are:\n" - " -h --help Show this help\n" - "\n" - " Machine parameters:\n" - " -t, --threads=x Number of CPU workers (default: automatic detection through runtime)\n" - " -g, --gpus=x Number of GPU workers (default: 0)\n" - " -P, --P=x Rows (P) in the PxQ process grid (deafult: 1)\n" - " --nocpu All GPU kernels are exclusively executed on GPUs (default: 0)\n" - "\n" - " Matrix parameters:\n" - " -m, --m, --M=x Dimension (M) of the matrices (default: N)\n" - " -n, --n, --N=x Dimension (N) of the matrices\n" - " -N, --n_range=R Range of N values\n" - " with R=Start:Stop:Step (default: 500:5000:500)\n" - " -k, --k, --K, --nrhs=x Dimension (K) of the matrices or number of right-hand size (default: 1)\n" - " -b, --nb=x NB size. (default: 320)\n" - " -i, --ib=x IB size. (default: 32)\n" - //" -x, --mx=x ?\n" todo - //" -X, --nx=x ?\n" todo - "\n" - " Check/prints:\n" - " --niter=x Number of iterations performed for each test (default: 1)\n" - " -W, --nowarnings Do not show warnings\n" - " -w, --nowarmup Cancel the warmup run to pre-load libraries\n" - " -c, --check Check result\n" - " -C, --inv Check on inverse\n" - " --mode=x Change xLATMS matrix mode generation for SVD/EVD (default: 4)\n" - " Must be between 0 and 20 included\n" - "\n" - " Profiling:\n" - " -T, --trace Enable trace generation\n" - " --progress Display progress indicator\n" - " -d, --dag Enable DAG generation\n" - " Generates a dot_dag_file.dot.\n" - " -p, --profile Print profiling informations\n" - "\n" - " HQR options:\n" - " -a, --qr_a, --rhblk=N If N > 0, enable Householder mode for QR and LQ factorization\n" - " N is the size of each subdomain (default: -1)\n" - " -l, --llvl=x Tree used for low level reduction inside nodes (default: -1)\n" - " -L, --hlvl=x Tree used for high level reduction between nodes, only if P > 1 (default: -1).\n" - " (-1: Automatic, 0: Flat, 1: Greedy, 2: Fibonacci, 3: Binary, 4: Replicated greedy)\n" - " -D, --domino Enable the domino between upper and lower trees.\n" - "\n" - " Advanced options\n" - " --nobigmat Disable single large matrix allocation for multiple tiled allocations\n" - " -s, --sync Enable synchronous calls in wrapper function such as POTRI\n" - " -o, --ooc Enable out-of-core (available only with StarPU)\n" - " -G, --gemm3m Use gemm3m complex method\n" - " --bound Compare result to area bound\n" - "\n"); -} - - -static void -print_header(char *prog_name, int * iparam) { - const char *bound_header = iparam[IPARAM_BOUND] ? " thGflop/s" : ""; - const char *check_header = iparam[IPARAM_CHECK] ? " ||Ax-b|| ||A|| ||x|| ||b|| ||Ax-b||/N/eps/(||A||||x||+||b||) RETURN" : ""; - const char *inverse_header = iparam[IPARAM_INVERSE] ? " ||I-A*Ainv|| ||A|| ||Ainv|| ||Id - A*Ainv||/((||A|| ||Ainv||).N.eps)" : ""; -#if defined(CHAMELEON_SIMULATION) - _PREC eps = 0.; -#else - _PREC eps = _LAMCH( 'e' ); -#endif - - printf( "#\n" - "# CHAMELEON %d.%d.%d, %s\n" - "# Nb threads: %d\n" - "# Nb GPUs: %d\n" -#if defined(CHAMELEON_USE_MPI) - "# Nb mpi: %d\n" - "# PxQ: %dx%d\n" -#endif - "# NB: %d\n" - "# IB: %d\n" - "# eps: %e\n" - "#\n", - CHAMELEON_VERSION_MAJOR, - CHAMELEON_VERSION_MINOR, - CHAMELEON_VERSION_MICRO, - prog_name, - iparam[IPARAM_THRDNBR], - iparam[IPARAM_NCUDAS], -#if defined(CHAMELEON_USE_MPI) - iparam[IPARAM_NMPI], - iparam[IPARAM_P], iparam[IPARAM_Q], -#endif - iparam[IPARAM_NB], - iparam[IPARAM_IB], - eps ); - - printf( "# M N K/NRHS seconds Gflop/s Deviation%s%s\n", - bound_header, iparam[IPARAM_INVERSE] ? inverse_header : check_header); - return; -} - -#define GETOPT_STRING "ht:g:P:8M:m:N:n:K:k:b:i:x:X:1:WwcCT2dpa:l:L:D9:3soG45" -#if defined(CHAMELEON_HAVE_GETOPT_LONG) -static struct option long_options[] = -{ - {"help", no_argument, 0, 'h'}, - // Configuration - {"threads", required_argument, 0, 't'}, - {"gpus", required_argument, 0, 'g'}, - {"P", required_argument, 0, 'P'}, - {"nocpu", no_argument, 0, '8'}, - // Matrix parameters - {"M", required_argument, 0, 'm'}, - {"m", required_argument, 0, 'm'}, - {"N", required_argument, 0, 'n'}, - {"n", required_argument, 0, 'n'}, - {"n_range", required_argument, 0, 'N'}, - {"K", required_argument, 0, 'K'}, - {"k", required_argument, 0, 'k'}, - {"nrhs", required_argument, 0, 'k'}, - {"nb", required_argument, 0, 'b'}, - {"ib", required_argument, 0, 'i'}, - {"mx", required_argument, 0, 'x'}, - {"nx", required_argument, 0, 'X'}, - // Check/prints - {"niter", required_argument, 0, '1'}, - {"nowarnings", no_argument, 0, 'W'}, - {"nowarmup", no_argument, 0, 'w'}, - {"check", no_argument, 0, 'c'}, - {"inv", no_argument, 0, 'C'}, - // Profiling - {"trace", no_argument, 0, 'T'}, - {"progress", no_argument, 0, '2'}, - {"dag", no_argument, 0, 'd'}, - {"profile", no_argument, 0, 'p'}, - // HQR options - {"rhblk", required_argument, 0, 'a'}, - {"qr_a", required_argument, 0, 'a'}, - {"llvl", required_argument, 0, 'l'}, - {"hlvl", required_argument, 0, 'L'}, - {"domino", no_argument, 0, 'D'}, - // Other - {"mode", required_argument, 0, '9'}, - {"nobigmat", no_argument, 0, '3'}, - {"sync", no_argument, 0, 's'}, - {"ooc", no_argument, 0, 'o'}, - {"gemm3m", no_argument, 0, 'G'}, - {"bound", no_argument, 0, '5'}, - {0, 0, 0, 0} -}; -#endif /* defined(CHAMELEON_HAVE_GETOPT_LONG) */ - -static void -set_iparam_default(int *iparam){ - - memset(iparam, 0, IPARAM_SIZEOF*sizeof(int)); - - iparam[IPARAM_THRDNBR ] = -1; - iparam[IPARAM_THRDNBR_SUBGRP] = 1; - iparam[IPARAM_M ] = -1; - iparam[IPARAM_N ] = -1; - iparam[IPARAM_K ] = 1; - iparam[IPARAM_LDA ] = -1; - iparam[IPARAM_LDB ] = -1; - iparam[IPARAM_LDC ] = -1; - iparam[IPARAM_MB ] = 320; - iparam[IPARAM_NB ] = 320; - iparam[IPARAM_IB ] = 32; - iparam[IPARAM_NITER ] = 1; - iparam[IPARAM_WARMUP ] = 1; - iparam[IPARAM_BIGMAT ] = 1; - iparam[IPARAM_ASYNC ] = 1; - iparam[IPARAM_MX ] = -1; - iparam[IPARAM_NX ] = -1; - iparam[IPARAM_MX ] = -1; - iparam[IPARAM_NX ] = -1; - iparam[IPARAM_INPLACE ] = ChamOutOfPlace; - iparam[IPARAM_NMPI ] = 1; - iparam[IPARAM_P ] = 1; - iparam[IPARAM_Q ] = 1; - iparam[IPARAM_PRINT_WARNINGS] = 1; - iparam[IPARAM_LOWLVL_TREE ] = -1; - iparam[IPARAM_HIGHLVL_TREE ] = -1; - iparam[IPARAM_QR_TS_SZE ] = -1; - iparam[IPARAM_QR_HLVL_SZE ] = -1; - iparam[IPARAM_QR_DOMINO ] = -1; -} - -static inline int -read_integer_from_options(int long_index, int opt_char) -{ - char *endptr; - long int value; - (void) long_index; - - value = strtol(optarg, &endptr, 10); - if ( *optarg == '\0' || *endptr != '\0' ) { -#ifdef CHAMELEON_HAVE_GETOPT_LONG - if ( long_index < 0 ) { -#endif - fprintf(stderr, "Invalid numeric value '%s' for '-%c' parameter\n", optarg, opt_char); -#ifdef CHAMELEON_HAVE_GETOPT_LONG - } else { - fprintf(stderr, "Invalid numeric value '%s' for '--%s' parameter\n", optarg, long_options[long_index].name); - } -#endif - exit(EXIT_FAILURE); - } - if ( value > INT_MAX || value < INT_MIN ) { - fprintf(stderr, "Out of range integer '%ld'\n", value); - exit(EXIT_FAILURE); - } - return (int)value; -} - -void -parse_arguments(int *_argc, char ***_argv, int *iparam, int *start, int *stop, int*step) -{ - int opt = -1; - int c; - int argc = *_argc; - char **argv = *_argv; - - optind = 1; - do { -#if defined(CHAMELEON_HAVE_GETOPT_LONG) - opt = -1; - c = getopt_long(argc, argv, GETOPT_STRING, - long_options, &opt); -#else - c = getopt(argc, argv, GETOPT_STRING); - (void) opt; -#endif /* defined(CHAMELEON_HAVE_GETOPT_LONG) */ - - switch(c) - { - // Configuration - case 't' : iparam[IPARAM_THRDNBR ] = read_integer_from_options(opt, c); break; - case 'g' : iparam[IPARAM_NCUDAS ] = read_integer_from_options(opt, c); break; - case 'P' : iparam[IPARAM_P ] = read_integer_from_options(opt, c); break; - case '8' : iparam[IPARAM_NO_CPU ] = 1; break; - // Matrix parameters - case 'M' : - case 'm' : iparam[IPARAM_M ] = read_integer_from_options(opt, c); break; - case 'n' : iparam[IPARAM_N ] = read_integer_from_options(opt, c); break; - case 'N' : get_range(optarg, start, stop, step); break; - case 'K' : - case 'k' : iparam[IPARAM_K ] = read_integer_from_options(opt, c); break; - case 'b' : iparam[IPARAM_NB ] = read_integer_from_options(opt, c); - iparam[IPARAM_MB ] = read_integer_from_options(opt, c); break; - case 'i' : iparam[IPARAM_IB ] = read_integer_from_options(opt, c); break; - case 'x' : iparam[IPARAM_MX ] = read_integer_from_options(opt, c); break; - case 'X' : iparam[IPARAM_NX ] = read_integer_from_options(opt, c); break; - // Check/prints - case '1' : iparam[IPARAM_NITER ] = read_integer_from_options(opt, c); break; - case 'W' : iparam[IPARAM_PRINT_WARNINGS] = 0; break; - case 'w' : iparam[IPARAM_WARMUP ] = 0; break; - case 'c' : iparam[IPARAM_CHECK ] = 1; break; - case 'C' : iparam[IPARAM_INVERSE ] = 1; break; - // Profiling - case 'T' : iparam[IPARAM_TRACE ] = 1; break; - case '2' : iparam[IPARAM_PROGRESS ] = 1; break; - case 'd' : iparam[IPARAM_DAG ] = 1; break; - case 'p' : iparam[IPARAM_PROFILE ] = 1; break; - // HQR options - case 'a' : iparam[IPARAM_RHBLK ] = read_integer_from_options(opt, c); break; - case 'l' : iparam[IPARAM_LOWLVL_TREE ] = read_integer_from_options(opt, c); break; - case 'L' : iparam[IPARAM_HIGHLVL_TREE ] = read_integer_from_options(opt, c); break; - case 'D' : iparam[IPARAM_QR_DOMINO ] = 1; break; - //Other - case '9' : iparam[IPARAM_MODE ] = read_integer_from_options(opt, c); break; - case '3' : iparam[IPARAM_BIGMAT ] = 0; break; - case 's' : iparam[IPARAM_ASYNC ] = 0; break; - case 'o' : iparam[IPARAM_OOC ] = 1; break; - case 'G' : iparam[IPARAM_GEMM3M ] = 1; break; - case '5' : iparam[IPARAM_BOUND ] = 1; break; - case 'h' : - case '?' : - show_help(argv[0]); exit(EXIT_FAILURE); - default: - break; - } - } while(-1 != c); -} - -// NOTE: this function is here to cope with the fact that OpenMP parallel -// regions must not have instructions jumping outside the region (eg: returns) - -int -timing_main(int *iparam, char *prog_name, int start, int stop, int step) { - - int status; - int i, m, n, k, mx, nx; - int nbnode = 1; - int success = 0; - - n = iparam[IPARAM_N]; - m = iparam[IPARAM_M]; - k = iparam[IPARAM_K]; - mx = iparam[IPARAM_MX]; - nx = iparam[IPARAM_NX]; - - - /* Get the number of threads set by the runtime */ - iparam[IPARAM_THRDNBR] = CHAMELEON_GetThreadNbr(); - - /* Stops profiling here to avoid profiling uninteresting routines. - It will be reactivated in the time_*.c routines with the macro START_TIMING() */ - RUNTIME_stop_profiling(); - - CHAMELEON_Disable(CHAMELEON_AUTOTUNING); - CHAMELEON_Set(CHAMELEON_TILE_SIZE, iparam[IPARAM_NB] ); - CHAMELEON_Set(CHAMELEON_INNER_BLOCK_SIZE, iparam[IPARAM_IB] ); - - /* Householder mode */ - if (iparam[IPARAM_RHBLK] < 1) { - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_MODE, ChamFlatHouseholder); - } else { - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_MODE, ChamTreeHouseholder); - CHAMELEON_Set(CHAMELEON_HOUSEHOLDER_SIZE, iparam[IPARAM_RHBLK]); - } - - if (iparam[IPARAM_PROFILE] == 1) { - CHAMELEON_Enable(CHAMELEON_PROFILING_MODE); - } - - if (iparam[IPARAM_PROGRESS] == 1) { - CHAMELEON_Enable(CHAMELEON_PROGRESS); - } - - if (iparam[IPARAM_PRINT_WARNINGS] == 0) { - CHAMELEON_Disable(CHAMELEON_WARNINGS); - } - - if (iparam[IPARAM_GEMM3M] == 1) { - CHAMELEON_Enable(CHAMELEON_GEMM3M); - } - -#if defined(CHAMELEON_USE_MPI) - nbnode = CHAMELEON_Comm_size(); - iparam[IPARAM_NMPI] = nbnode; - /* Check P */ - if ( (iparam[IPARAM_P] > 1) && - (nbnode % iparam[IPARAM_P] != 0) ) { - fprintf(stderr, "ERROR: %d doesn't divide the number of node %d\n", - iparam[IPARAM_P], nbnode ); - return EXIT_FAILURE; - } -#endif - iparam[IPARAM_Q] = nbnode / iparam[IPARAM_P]; - - /* Layout conversion */ - CHAMELEON_Set(CHAMELEON_TRANSLATION_MODE, iparam[IPARAM_INPLACE]); - - if ( CHAMELEON_Comm_rank() == 0 ) { - print_header( prog_name, iparam); - } - - if (step < 1) step = 1; - - status = Test( -1, iparam ); /* print header */ - if (status != CHAMELEON_SUCCESS) return status; - if ( n == -1 ){ - for (i = start; i <= stop; i += step) - { - if ( nx > 0 ) { - iparam[IPARAM_M] = i; - iparam[IPARAM_N] = chameleon_max(1, i/nx); - } - else if ( mx > 0 ) { - iparam[IPARAM_M] = chameleon_max(1, i/mx); - iparam[IPARAM_N] = i; - } - else { - if ( m == -1 ) { - iparam[IPARAM_M] = i; - } - if ( k == -1 ) { - iparam[IPARAM_K] = i; - } - iparam[IPARAM_N] = i; - } - status = Test( iparam[IPARAM_N], iparam ); - if (status != CHAMELEON_SUCCESS) { - return status; - } - success += status; - } - } - else { - if ( m == -1 ) { - iparam[IPARAM_M] = n; - } - if ( k == -1 ) { - iparam[IPARAM_K] = n; - } - iparam[IPARAM_N] = n; - status = Test( iparam[IPARAM_N], iparam ); - if (status != CHAMELEON_SUCCESS) return status; - success += status; - } - return success; -} - -int -main(int argc, char *argv[]) { - int start = 500; - int stop = 5000; - int step = 500; - int iparam[IPARAM_SIZEOF]; - int return_code; - - set_iparam_default(iparam); - - parse_arguments(&argc, &argv, iparam, &start, &stop, &step); - - /* Initialize CHAMELEON */ - CHAMELEON_Init( iparam[IPARAM_THRDNBR], - iparam[IPARAM_NCUDAS] ); - /* - * NOTE: OpenMP needs this, as Chameleon's init/finalize add '{'/'}', - * and 'return' is not allowed in parallel regions. - */ - return_code = timing_main(iparam, argv[0], start, stop, step); - - CHAMELEON_Finalize(); - return return_code; -} - diff --git a/timing/timing.h b/timing/timing.h deleted file mode 100644 index 2ffbb9573e14fad5f77520a83304ab7df118e95e..0000000000000000000000000000000000000000 --- a/timing/timing.h +++ /dev/null @@ -1,245 +0,0 @@ -/** - * - * @file timing.h - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2014-11-16 - * - */ -#ifndef _timing_h_ -#define _timing_h_ - -typedef double chameleon_time_t; - -enum iparam_timing { - IPARAM_THRDNBR, /* Number of cores */ - IPARAM_THRDNBR_SUBGRP, /* Number of cores in a subgroup (NUMA node) */ - IPARAM_SCHEDULER, /* What scheduler do we choose (dyn, stat) */ - IPARAM_M, /* Number of rows of the matrix */ - IPARAM_N, /* Number of columns of the matrix */ - IPARAM_K, /* RHS or K */ - IPARAM_LDA, /* Leading dimension of A */ - IPARAM_LDB, /* Leading dimension of B */ - IPARAM_LDC, /* Leading dimension of C */ - IPARAM_IB, /* Inner-blocking size */ - IPARAM_NB, /* Number of columns in a tile */ - IPARAM_MB, /* Number of rows in a tile */ - IPARAM_NITER, /* Number of iteration of each test */ - IPARAM_WARMUP, /* Run one test to load dynamic libraries */ - IPARAM_BIGMAT, /* Allocating one big mat or plenty of small */ - IPARAM_CHECK, /* Checking activated or not */ - IPARAM_VERBOSE, /* How much noise do we want? */ - IPARAM_AUTOTUNING, /* Disable/enable autotuning */ - IPARAM_INPUTFMT, /* Input format (Use only for getmi/gecfi) */ - IPARAM_OUTPUTFMT, /* Output format (Use only for getmi/gecfi) */ - IPARAM_TRACE, /* Generate trace on the first non warmup run */ - IPARAM_DAG, /* Do we require to output the DOT file? */ - IPARAM_ASYNC, /* Asynchronous calls */ - IPARAM_OOC, /* Out of Core */ - IPARAM_MX, /* */ - IPARAM_NX, /* */ - IPARAM_RHBLK, /* Householder reduction parameter for QR/LQ */ - IPARAM_INPLACE, /* InPlace/OutOfPlace translation mode */ - IPARAM_MODE, /* Eigenvalue generation mode */ - - IPARAM_INVERSE, - IPARAM_NCUDAS, - IPARAM_NMPI, - IPARAM_P, /* Parameter for 2D cyclic distribution */ - IPARAM_Q, /* Parameter for 2D cyclic distribution */ - - IPARAM_PROGRESS, /* Use a progress indicator during computations */ - IPARAM_GEMM3M, /* Use GEMM3M for complex matrix vector products */ - /* Added for StarPU version */ - IPARAM_PROFILE, - IPARAM_PRINT_WARNINGS, - IPARAM_PARALLEL_TASKS, - IPARAM_NO_CPU, - IPARAM_BOUND, - /* End */ - /* Added for libhqr version */ - IPARAM_LOWLVL_TREE, /* Tree used for reduction inside nodes */ - IPARAM_HIGHLVL_TREE, /* Tree used for reduction between nodes */ - IPARAM_QR_TS_SZE, /* Size of TS domain */ - IPARAM_QR_HLVL_SZE, /* Size of the high level tree */ - IPARAM_QR_DOMINO, /* Enable/disable the domino tree */ - IPARAM_QR_TSRR, /* Enable/disable the round-robin on TS domain */ - /* End */ - IPARAM_SIZEOF -}; - -enum dparam_timing { - IPARAM_TIME, - IPARAM_ANORM, - IPARAM_BNORM, - IPARAM_XNORM, - IPARAM_RNORM, - IPARAM_AinvNORM, - IPARAM_RES, - /* Begin section for hydra integration tool */ - IPARAM_THRESHOLD_CHECK, /* Maximum value accepted for: |Ax-b||/N/eps/(||A||||x||+||b||) */ - /* End section for hydra integration tool */ - IPARAM_DNBPARAM -}; - -#define PASTE_CODE_IPARAM_LOCALS(iparam) \ - double t; \ - int64_t M = iparam[IPARAM_M]; \ - int64_t N = iparam[IPARAM_N]; \ - int64_t K = iparam[IPARAM_K]; \ - int64_t NRHS = K; \ - int64_t LDA = chameleon_max(M, iparam[IPARAM_LDA]); \ - int64_t LDB = chameleon_max(N, iparam[IPARAM_LDB]); \ - int64_t LDC = chameleon_max(K, iparam[IPARAM_LDC]); \ - int64_t IB = iparam[IPARAM_IB]; \ - int64_t MB = iparam[IPARAM_MB]; \ - int64_t NB = iparam[IPARAM_NB]; \ - int64_t P = iparam[IPARAM_P]; \ - int64_t Q = iparam[IPARAM_Q]; \ - int64_t MT = (M%MB==0) ? (M/MB) : (M/MB+1); \ - int64_t NT = (N%NB==0) ? (N/NB) : (N/NB+1); \ - int bigmat = iparam[IPARAM_BIGMAT]; \ - int ooc = iparam[IPARAM_OOC]; \ - int check = iparam[IPARAM_CHECK]; \ - int loud = iparam[IPARAM_VERBOSE]; \ - (void)M;(void)N;(void)K;(void)NRHS; \ - (void)LDA;(void)LDB;(void)LDC; \ - (void)IB;(void)MB;(void)NB;(void)P;(void)Q; \ - (void)MT;(void)NT;(void)check; \ - (void)loud;(void)bigmat;(void)ooc; - -/* Paste code to allocate a matrix in desc if cond_init is true */ -#define PASTE_CODE_ALLOCATE_MATRIX_TILE(_desc_, _cond_, _type_, _type2_, _lda_, _m_, _n_) \ - CHAM_desc_t *_desc_ = NULL; \ - int status ## _desc_ ; \ - if( _cond_ ) { \ - if (ooc) \ - status ## _desc_ = CHAMELEON_Desc_Create_OOC(&(_desc_), _type2_, MB, NB, MB*NB, _lda_, _n_, 0, 0, _m_, _n_, \ - P, Q); \ - else if (!bigmat) \ - status ## _desc_ = CHAMELEON_Desc_Create_User(&(_desc_), NULL, _type2_, MB, NB, MB*NB, _lda_, _n_, 0, 0, _m_, _n_, \ - P, Q, chameleon_getaddr_null, NULL, NULL); \ - else \ - status ## _desc_ = CHAMELEON_Desc_Create(&(_desc_), NULL, _type2_, MB, NB, MB*NB, _lda_, _n_, 0, 0, _m_, _n_, \ - P, Q); \ - if (status ## _desc_ != CHAMELEON_SUCCESS) return (status ## _desc_); \ - } - -#define PASTE_CODE_FREE_MATRIX(_desc_) \ - CHAMELEON_Desc_Destroy( &_desc_ ); - -#define PASTE_TILE_TO_LAPACK(_desc_, _name_, _cond_, _type_, _lda_, _n_) \ - _type_ *_name_ = NULL; \ - if ( _cond_ ) { \ - _name_ = (_type_*)malloc( (_lda_) * (_n_) * sizeof(_type_)); \ - if ( ! _name_ ) { \ - fprintf(stderr, "Out of Memory for %s\n", #_name_); \ - return -1; \ - } \ - CHAMELEON_Tile_to_Lapack(_desc_, (void*)_name_, _lda_); \ - } - -#define PASTE_CODE_ALLOCATE_MATRIX(_name_, _cond_, _type_, _lda_, _n_) \ - _type_ *_name_ = NULL; \ - if( _cond_ ) { \ - _name_ = (_type_*)malloc( (_lda_) * (_n_) * sizeof(_type_) ); \ - if ( ! _name_ ) { \ - fprintf(stderr, "Out of Memory for %s\n", #_name_); \ - return -1; \ - } \ - } - -#define PASTE_CODE_ALLOCATE_COPY(_name_, _cond_, _type_, _orig_, _lda_, _n_) \ - _type_ *_name_ = NULL; \ - if( _cond_ ) { \ - _name_ = (_type_*)malloc( (_lda_) * (_n_) * sizeof(_type_) ); \ - if ( ! _name_ ) { \ - fprintf(stderr, "Out of Memory for %s\n", #_name_); \ - return -1; \ - } \ - memcpy(_name_, _orig_, (_lda_) * (_n_) * sizeof(_type_) ); \ - } - -/** - * - * Macro for trace generation - * - */ -#define START_TRACING() \ - RUNTIME_start_stats(); \ - if(iparam[IPARAM_TRACE] == 2) { \ - RUNTIME_start_profiling(); \ - } \ - if(iparam[IPARAM_BOUND]) { \ - CHAMELEON_Enable(CHAMELEON_BOUND); \ - } - -#define STOP_TRACING() \ - RUNTIME_stop_stats(); \ - if(iparam[IPARAM_TRACE] == 2) { \ - RUNTIME_stop_profiling(); \ - } \ - if(iparam[IPARAM_BOUND]) { \ - CHAMELEON_Disable(CHAMELEON_BOUND); \ - } - -/** - * - * Macro for DAG generation - * - */ -#if 0 -#define START_DAG() \ - if ( iparam[IPARAM_DAG] == 2 ) \ - CHAMELEON_Enable(CHAMELEON_DAG); - -#define STOP_DAG() \ - if ( iparam[IPARAM_DAG] == 2 ) \ - CHAMELEON_Disable(CHAMELEON_DAG); -#else -#define START_DAG() do {} while(0); -#define STOP_DAG() do {} while(0); -#endif - -/** - * - * Synchro for distributed computations - * - */ -#if defined(CHAMELEON_USE_MPI) -#define START_DISTRIBUTED() CHAMELEON_Distributed_start(); -#define STOP_DISTRIBUTED() CHAMELEON_Distributed_stop(); -#else -#define START_DISTRIBUTED() do {} while(0); -#define STOP_DISTRIBUTED() do {} while(0); -#endif - -/** - * - * General Macros for timing - * - */ -#define START_TIMING() \ - START_DAG(); \ - START_TRACING(); \ - START_DISTRIBUTED(); \ - t = -RUNTIME_get_time(); - -#define STOP_TIMING() \ - STOP_DISTRIBUTED(); \ - t += RUNTIME_get_time(); \ - STOP_TRACING(); \ - STOP_DAG(); \ - if (iparam[IPARAM_PROFILE] == 2) { \ - RUNTIME_kernelprofile_display(); \ - RUNTIME_schedprofile_display(); \ - } \ - *t_ = t; - -#endif /* _timing_h_ */ diff --git a/timing/timing_zauxiliary.c b/timing/timing_zauxiliary.c deleted file mode 100644 index b8c995e34f2a6b18a60ecd70e2d68ba981c5f1b7..0000000000000000000000000000000000000000 --- a/timing/timing_zauxiliary.c +++ /dev/null @@ -1,436 +0,0 @@ -/** - * - * @file timing_zauxiliary.c - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-03-24 - * @precisions normal z -> c d s - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include <math.h> -#include <chameleon.h> -#include <coreblas/cblas.h> -#include <coreblas/lapacke.h> -#include <coreblas.h> -#include "timing_zauxiliary.h" - -/*------------------------------------------------------------------- - * Check the orthogonality of Q - */ - -int z_check_orthogonality(int M, int N, int LDQ, CHAMELEON_Complex64_t *Q) -{ - double alpha, beta; - double normQ; - int info_ortho; - int i; - int minMN = chameleon_min(M, N); - double eps; - double *work = (double *)malloc(minMN*sizeof(double)); - - eps = LAPACKE_dlamch_work('e'); - alpha = 1.0; - beta = -1.0; - - /* Build the idendity matrix USE DLASET?*/ - CHAMELEON_Complex64_t *Id = (CHAMELEON_Complex64_t *) malloc(minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - memset((void*)Id, 0, minMN*minMN*sizeof(CHAMELEON_Complex64_t)); - for (i = 0; i < minMN; i++) - Id[i*minMN+i] = (CHAMELEON_Complex64_t)1.0; - - /* Perform Id - Q'Q */ - if (M >= N) - cblas_zherk(CblasColMajor, CblasUpper, CblasConjTrans, N, M, alpha, Q, LDQ, beta, Id, N); - else - cblas_zherk(CblasColMajor, CblasUpper, CblasNoTrans, M, N, alpha, Q, LDQ, beta, Id, M); - - normQ = LAPACKE_zlansy_work(LAPACK_COL_MAJOR, 'I', 'u', minMN, Id, minMN, work); - - printf("============\n"); - printf("Checking the orthogonality of Q \n"); - printf("||Id-Q'*Q||_oo / (N*eps) = %e \n",normQ/(minMN*eps)); - - if ( isnan(normQ / (minMN * eps)) || (normQ / (minMN * eps) > 10.0) ) { - printf("-- Orthogonality is suspicious ! \n"); - info_ortho=1; - } - else { - printf("-- Orthogonality is CORRECT ! \n"); - info_ortho=0; - } - - free(work); free(Id); - - return info_ortho; -} - -/*------------------------------------------------------------ - * Check the factorization QR - */ - -int z_check_QRfactorization(int M, int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, CHAMELEON_Complex64_t *Q) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha, beta; - int info_factorization; - int i,j; - double eps; - - eps = LAPACKE_dlamch_work('e'); - - CHAMELEON_Complex64_t *Ql = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(M*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(chameleon_max(M,N)*sizeof(double)); - - alpha=1.0; - beta=0.0; - - if (M >= N) { - /* Extract the R */ - CHAMELEON_Complex64_t *R = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)R, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', M, N, A2, LDA, R, N); - - /* Perform Ql=Q*R */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, N, CBLAS_SADDR(alpha), Q, LDA, R, N, CBLAS_SADDR(beta), Ql, M); - free(R); - } - else { - /* Extract the L */ - CHAMELEON_Complex64_t *L = (CHAMELEON_Complex64_t *)malloc(M*M*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L, 0, M*M*sizeof(CHAMELEON_Complex64_t)); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', M, N, A2, LDA, L, M); - - /* Perform Ql=LQ */ - memset((void*)Ql, 0, M*N*sizeof(CHAMELEON_Complex64_t)); - cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, M, N, M, CBLAS_SADDR(alpha), L, M, Q, LDA, CBLAS_SADDR(beta), Ql, M); - free(L); - } - - /* Compute the Residual */ - for (i = 0; i < M; i++) - for (j = 0 ; j < N; j++) - Residual[j*M+i] = A1[j*LDA+i]-Ql[j*M+i]; - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Residual, M, work); - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, A2, LDA, work); - - if (M >= N) { - printf("============\n"); - printf("Checking the QR Factorization \n"); - printf("-- ||A-QR||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - else { - printf("============\n"); - printf("Checking the LQ Factorization \n"); - printf("-- ||A-LQ||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - } - - if (isnan(Rnorm / (Anorm * N *eps)) || (Rnorm / (Anorm * N * eps) > 10.0) ) { - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else { - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(work); free(Ql); free(Residual); - - return info_factorization; -} - -/*------------------------------------------------------------------------ - * Check the factorization of the matrix A2 - */ - -int z_check_LLTfactorization(int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, cham_uplo_t uplo) -{ - double Anorm, Rnorm; - CHAMELEON_Complex64_t alpha; - int info_factorization; - int i,j; - double eps; - - eps = LAPACKE_dlamch_work('e'); - - CHAMELEON_Complex64_t *Residual = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L1 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - CHAMELEON_Complex64_t *L2 = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - double *work = (double *)malloc(N*sizeof(double)); - - memset((void*)L1, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - memset((void*)L2, 0, N*N*sizeof(CHAMELEON_Complex64_t)); - - alpha= 1.0; - - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,' ', N, N, A1, LDA, Residual, N); - - /* Dealing with L'L or U'U */ - if (uplo == ChamUpper){ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'u', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasLeft, CblasUpper, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - else{ - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L1, N); - LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,'l', N, N, A2, LDA, L2, N); - cblas_ztrmm(CblasColMajor, CblasRight, CblasLower, CblasConjTrans, CblasNonUnit, N, N, CBLAS_SADDR(alpha), L1, N, L2, N); - } - - /* Compute the Residual || A -L'L|| */ - for (i = 0; i < N; i++) - for (j = 0; j < N; j++) - Residual[j*N+i] = L2[j*N+i] - Residual[j*N+i]; - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, Residual, N, work); - Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, N, A1, LDA, work); - - printf("============\n"); - printf("Checking the Cholesky Factorization \n"); - printf("-- ||L'L-A||_oo/(||A||_oo.N.eps) = %e \n",Rnorm/(Anorm*N*eps)); - - if ( isnan(Rnorm/(Anorm*N*eps)) || (Rnorm/(Anorm*N*eps) > 10.0) ){ - printf("-- Factorization is suspicious ! \n"); - info_factorization = 1; - } - else{ - printf("-- Factorization is CORRECT ! \n"); - info_factorization = 0; - } - - free(Residual); free(L1); free(L2); free(work); - - return info_factorization; -} - -/*-------------------------------------------------------------- - * Check the gemm - */ -double z_check_gemm(cham_trans_t transA, cham_trans_t transB, int M, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ) -{ - CHAMELEON_Complex64_t beta_const = -1.0; - double Rnorm; - double *work = (double *)malloc(chameleon_max(K,chameleon_max(M, N))* sizeof(double)); - - *Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - *Cchamnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work); - - cblas_zgemm(CblasColMajor, (CBLAS_TRANSPOSE)transA, (CBLAS_TRANSPOSE)transB, M, N, K, - CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC); - - *Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - cblas_zaxpy(LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work); - - free(work); - - return Rnorm; -} - -#if defined(PRECISION_z) || defined(PRECISION_c) -/*-------------------------------------------------------------- - * Check the hemm - */ -double z_check_hemm( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, const CHAMELEON_Complex64_t *A, int LDA, - const CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, const CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ) -{ - CHAMELEON_Complex64_t beta_const = -1.0; - double Rnorm; - double *work = (double *)malloc( chameleon_max(M, N)* sizeof(double) ); - - *Cinitnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - *Cchamnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work ); - - cblas_zhemm( CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, M, N, - CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC ); - - *Clapacknorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - - cblas_zaxpy( LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1 ); - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - - free(work); - - return Rnorm; -} -#endif /* defined(PRECISION_z) || defined(PRECISION_c) */ - -/*-------------------------------------------------------------- - * Check the symm - */ -double z_check_symm( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, const CHAMELEON_Complex64_t *A, int LDA, - const CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, const CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ) -{ - CHAMELEON_Complex64_t beta_const = -1.0; - double Rnorm; - double *work = (double *)malloc( chameleon_max(M, N)* sizeof(double) ); - - *Cinitnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - *Cchamnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Ccham, LDC, work ); - - cblas_zsymm( CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, M, N, - CBLAS_SADDR(alpha), A, LDA, B, LDB, CBLAS_SADDR(beta), Cref, LDC ); - - *Clapacknorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - - cblas_zaxpy( LDC * N, CBLAS_SADDR(beta_const), Ccham, 1, Cref, 1 ); - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'I', M, N, Cref, LDC, work ); - - free(work); - - return Rnorm; -} - -/*-------------------------------------------------------------- - * Check the trsm - */ -double z_check_trsm(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int NRHS, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bcham, CHAMELEON_Complex64_t *Bref, int LDB, - double *Binitnorm, double *Bchamnorm, double *Blapacknorm ) -{ - CHAMELEON_Complex64_t beta_const = -1.0; - double Rnorm; - double *work = (double *)malloc(chameleon_max(M, NRHS)* sizeof(double)); - /*double eps = LAPACKE_dlamch_work('e');*/ - - *Binitnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, Bref, LDB, work ); - *Bchamnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, Bcham, LDB, work ); - - cblas_ztrsm( CblasColMajor, (CBLAS_SIDE)side, (CBLAS_UPLO)uplo, - (CBLAS_TRANSPOSE)trans, (CBLAS_DIAG)diag, M, NRHS, - CBLAS_SADDR(alpha), A, LDA, Bref, LDB ); - - *Blapacknorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, Bref, LDB, work ); - - cblas_zaxpy( LDB * NRHS, CBLAS_SADDR(beta_const), Bcham, 1, Bref, 1 ); - - Rnorm = LAPACKE_zlange_work( LAPACK_COL_MAJOR, 'i', M, NRHS, Bref, LDB, work ); - Rnorm = Rnorm / *Blapacknorm; - /* chameleon_max(M,NRHS) * eps);*/ - - free(work); - - return Rnorm; -} - -/*-------------------------------------------------------------- - * Check the solution - */ - -double z_check_solution(int M, int N, int NRHS, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, CHAMELEON_Complex64_t *X, int LDB, - double *anorm, double *bnorm, double *xnorm ) -{ -/* int info_solution; */ - double Rnorm = -1.00; - CHAMELEON_Complex64_t zone = 1.0; - CHAMELEON_Complex64_t mzone = -1.0; - double *work = (double *)malloc(chameleon_max(M, N)* sizeof(double)); - - *anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, N, A, LDA, work); - *xnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', M, NRHS, X, LDB, work); - *bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, NRHS, B, LDB, work); - - cblas_zgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, M, NRHS, N, - CBLAS_SADDR(zone), A, LDA, X, LDB, - CBLAS_SADDR(mzone), B, LDB ); - - Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'I', N, NRHS, B, LDB, work); - - free(work); - - return Rnorm; -} - -/*------------------------------------------------------------------------ - * * Check the accuracy of the computed inverse - * */ - -int z_check_inverse( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, - cham_uplo_t uplo, double *rnorm, double *anorm, double *ainvnorm ) -{ - int info_inverse; - int i, j; - double result; - CHAMELEON_Complex64_t alpha, beta, zone; - CHAMELEON_Complex64_t *workz = (CHAMELEON_Complex64_t *)malloc(N*N*sizeof(CHAMELEON_Complex64_t)); - double *workd = (double *)malloc(N*sizeof(double)); - double eps; - - eps = LAPACKE_dlamch_work('e'); - - alpha = -1.0; - beta = 0.0; - zone = 1.0; - - /* Rebuild the other part of the inverse matrix */ - if(uplo == ChamUpper){ - for(j=0; j<N; j++) - for(i=0; i<j; i++) - *(A2+j+i*LDA) = *(A2+i+j*LDA); - cblas_zhemm(CblasColMajor, CblasLeft, CblasUpper, N, N, CBLAS_SADDR(alpha), A2, LDA, A1, LDA, CBLAS_SADDR(beta), workz, N); - - } - else { - for(j=0; j<N; j++) - for(i=j; i<N; i++) - *(A2+j+i*LDA) = *(A2+i+j*LDA); - cblas_zhemm(CblasColMajor, CblasLeft, CblasLower, N, N, CBLAS_SADDR(alpha), A2, LDA, A1, LDA, CBLAS_SADDR(beta), workz, N); - } - - /* Add the identity matrix to workz */ - for(i=0; i<N; i++) - *(workz+i+i*N) = *(workz+i+i*N) + zone; - - - *rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'O', N, N, workz, N, workd); - *anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'O', N, N, A1, LDA, workd); - *ainvnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, 'O', N, N, A2, LDA, workd); - - - result = *rnorm / ( ((*anorm) * (*ainvnorm))*N*eps ) ; - - if ( isnan(*ainvnorm) || isinf(*ainvnorm) || isnan(result) || isinf(result) || (result > 60.0) ) { - info_inverse = 1; - } - else{ - info_inverse = 0; - } - - free(workz); - free(workd); - - return info_inverse; -} diff --git a/timing/timing_zauxiliary.h b/timing/timing_zauxiliary.h deleted file mode 100644 index ed9c7df0bf5f4f13da61317923821c39f38607d4..0000000000000000000000000000000000000000 --- a/timing/timing_zauxiliary.h +++ /dev/null @@ -1,61 +0,0 @@ -/** - * - * @file timing_zauxiliary.h - * - * @copyright 2009-2014 The University of Tennessee and The University of - * Tennessee Research Foundation. All rights reserved. - * @copyright 2012-2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, - * Univ. Bordeaux. All rights reserved. - * - *** - * - * @version 0.9.2 - * @author Mathieu Faverge - * @date 2015-03-24 - * @precisions normal z -> c d s - * - */ -#ifndef _timing_zauxiliary_h_ -#define _timing_zauxiliary_h_ - -int z_check_orthogonality (int M, int N, int LDQ, CHAMELEON_Complex64_t *Q); -int z_check_QRfactorization (int M, int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, CHAMELEON_Complex64_t *Q); -int z_check_LLTfactorization(int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, int LDA, cham_uplo_t uplo); -double z_check_gemm(cham_trans_t transA, cham_trans_t transB, int M, int N, int K, - CHAMELEON_Complex64_t alpha, CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ); - -#if defined(PRECISION_z) || defined(PRECISION_c) -double z_check_hemm( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, const CHAMELEON_Complex64_t *A, int LDA, - const CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, const CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ); -#endif -double z_check_symm( cham_side_t side, cham_uplo_t uplo, int M, int N, - CHAMELEON_Complex64_t alpha, const CHAMELEON_Complex64_t *A, int LDA, - const CHAMELEON_Complex64_t *B, int LDB, - CHAMELEON_Complex64_t beta, const CHAMELEON_Complex64_t *Ccham, - CHAMELEON_Complex64_t *Cref, int LDC, - double *Cinitnorm, double *Cchamnorm, double *Clapacknorm ); - -double z_check_trsm(cham_side_t side, cham_uplo_t uplo, cham_trans_t trans, cham_diag_t diag, - int M, int NRHS, CHAMELEON_Complex64_t alpha, - CHAMELEON_Complex64_t *A, int LDA, - CHAMELEON_Complex64_t *Bcham, CHAMELEON_Complex64_t *Bref, int LDB, - double *Binitnorm, double *Bchamnorm, double *Blapacknorm ); - -double z_check_solution(int M, int N, int NRHS, - CHAMELEON_Complex64_t *A1, int LDA, - CHAMELEON_Complex64_t *B1, CHAMELEON_Complex64_t *B2, int LDB, - double *anorm, double *bnorm, double *xnorm); - -int z_check_inverse( int N, CHAMELEON_Complex64_t *A1, CHAMELEON_Complex64_t *A2, - int LDA, cham_uplo_t uplo, double *rnorm, double *anorm, double *ainvnorm ); - - -#endif /* _timing_zauxiliary_h_ */ diff --git a/tools/analysis.sh b/tools/analysis.sh index b619a807da3a5fb21de86124558d46d3241d5260..6032cd5ebd14aaab21d165f006f838df81da2d0d 100755 --- a/tools/analysis.sh +++ b/tools/analysis.sh @@ -47,15 +47,14 @@ sonar.projectDescription=Dense linear algebra subroutines for heterogeneous and sonar.projectVersion=0.9 sonar.language=c -sonar.sources=build-openmp/runtime/openmp, build-parsec/runtime/parsec, build-quark/runtime/quark, build-starpu, compute, control, coreblas, example, include, runtime, new-testing +sonar.sources=build-openmp/runtime/openmp, build-parsec/runtime/parsec, build-quark/runtime/quark, build-starpu, compute, control, coreblas, example, include, runtime, testing sonar.inclusions=`cat filelist.txt | sed ':a;N;$!ba;s/\n/, /g'` sonar.c.includeDirectories=$(echo | gcc -E -Wp,-v - 2>&1 | grep "^ " | tr '\n' ',').,$(find . -type f -name '*.h' | sed -r 's|/[^/]+$||' |sort |uniq | xargs echo | sed -e 's/ /,/g'),$PARSEC_DIR/include,$QUARK_DIR/include,$STARPU_DIR/include/starpu/1.2,$SIMGRID_DIR/include sonar.sourceEncoding=UTF-8 sonar.c.errorRecoveryEnabled=true -sonar.c.compiler.charset=UTF-8 -sonar.c.compiler.parser=GCC -sonar.c.compiler.regex=^(.*):(\\\d+):\\\d+: warning: (.*)\\\[(.*)\\\]$ -sonar.c.compiler.reportPath=chameleon_build.log +sonar.c.gcc.charset=UTF-8 +sonar.c.gcc.regex=(?<file>.*):(?<line>[0-9]+):[0-9]+:\\\x20warning:\\\x20(?<message>.*)\\\x20\\\[(?<id>.*)\\\] +sonar.c.gcc.reportPath=chameleon_build.log sonar.c.coverage.reportPath=chameleon_coverage.xml sonar.c.cppcheck.reportPath=chameleon_cppcheck.xml sonar.c.clangsa.reportPath=build-openmp/analyzer_reports/*/*.plist, build-parsec/analyzer_reports/*/*.plist, build-quark/analyzer_reports/*/*.plist, build-starpu/analyzer_reports/*/*.plist, build-starpu_simgrid/analyzer_reports/*/*.plist diff --git a/tools/bench/plafrim/parameters/bora/parameters.xml b/tools/bench/plafrim/parameters/bora/parameters.xml index e7e4f1486fbf5839259c4e613ab40509191c718c..279d70b5e8525f14f1cd99e96334e9d287e374a0 100644 --- a/tools/bench/plafrim/parameters/bora/parameters.xml +++ b/tools/bench/plafrim/parameters/bora/parameters.xml @@ -15,7 +15,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*32*${b}][$i_mn]</parameter> <parameter name="k" mode="python" type="int" >${m}</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_potrf"> <parameter name="hostname" type="string">bora</parameter> @@ -32,7 +32,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*32*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_geqrf"> <parameter name="hostname" type="string">bora</parameter> @@ -49,6 +49,6 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*32*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> </jube> diff --git a/tools/bench/plafrim/parameters/miriel/parameters.xml b/tools/bench/plafrim/parameters/miriel/parameters.xml index 00622ac1a85a71738746b007b3cd1f4be70e27c6..54c33d13a589447eb5559084114c8d9c5be4ab29 100644 --- a/tools/bench/plafrim/parameters/miriel/parameters.xml +++ b/tools/bench/plafrim/parameters/miriel/parameters.xml @@ -15,7 +15,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*24*${b}][$i_mn]</parameter> <parameter name="k" mode="python" type="int" >${m}</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_potrf"> <parameter name="hostname" type="string">miriel</parameter> @@ -32,7 +32,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*24*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_geqrf"> <parameter name="hostname" type="string">miriel</parameter> @@ -49,6 +49,6 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*24*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> </jube> diff --git a/tools/bench/plafrim/parameters/sirocco/parameters.xml b/tools/bench/plafrim/parameters/sirocco/parameters.xml index 873195b2253e43ef010eeb283614cddeeffb40aa..c5e869ea3376438a1d5f31049bbb51ce3a23c7c6 100644 --- a/tools/bench/plafrim/parameters/sirocco/parameters.xml +++ b/tools/bench/plafrim/parameters/sirocco/parameters.xml @@ -15,7 +15,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*5*${b}, ${nmpi}*10*${b}, ${nmpi}*20*${b}, ${nmpi}*40*${b}][$i_mn]</parameter> <parameter name="k" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*5*${b}, ${nmpi}*10*${b}, ${nmpi}*20*${b}, ${nmpi}*40*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*5*${b}, ${nmpi}*10*${b}, ${nmpi}*20*${b}, ${nmpi}*40*${b}][$i_mn]</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_potrf"> <parameter name="hostname" type="string">sirocco</parameter> @@ -32,7 +32,7 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*32*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> <parameterset name="param_geqrf"> <parameter name="hostname" type="string">sirocco</parameter> @@ -49,6 +49,6 @@ <parameter name="m" mode="python" type="int" >[${nmpi}*${b}, ${nmpi}*2*${b}, ${nmpi}*4*${b}, ${nmpi}*8*${b}, ${nmpi}*16*${b}, ${nmpi}*32*${b}][$i_mn]</parameter> <parameter name="n" mode="python" type="int" >${m}</parameter> <parameter name="k" type="int" >1</parameter> - <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/new-testing/${precision}new-testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> + <parameter name="command" type="string">mpiexec $MPI_OPTIONS -np $nmpi $CHAMELEON_BUILD/testing/chameleon_${precision}testing -o ${algorithm} -P $p -t $nthr -g $ngpu -m $m -n $n -k $k -b $b</parameter> </parameterset> </jube> diff --git a/tools/check_header.sh b/tools/check_header.sh index 46dd216a5abd15348e8a23b034579aa59f5da35d..8d0c21d2e9f0814a3a0c73aac084a61e21b95209 100755 --- a/tools/check_header.sh +++ b/tools/check_header.sh @@ -1,12 +1,12 @@ # # @file check_header.sh # -# @copyright 2016-2017 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2016-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # -# @version 6.0.0 +# @version 1.0.0 # @author Mathieu Faverge -# @date 2018-10-12 +# @date 2020-03-03 # # This script check that basic informations is present and correct in # headers of source files. @@ -53,10 +53,10 @@ check_header_copyright() filename=$1 basename=`basename $filename` - toto=`grep -E " @copyright [0-9]{4}-2019 Bordeaux INP" $filename` + toto=`grep -E " @copyright [0-9]{4}-2020 Bordeaux INP" $filename` if [ $? -ne 0 ] then - toto=`grep -E " @copyright 2019 Bordeaux INP" $filename` + toto=`grep -E " @copyright 2020 Bordeaux INP" $filename` fi if [ $? -ne 0 ] diff --git a/tools/find_sources.sh b/tools/find_sources.sh index 43b9e4d55a8813b82c03713508631ede5c962ed6..faa52b728f66d6420ec2068ce67eb8ea1f60bc45 100755 --- a/tools/find_sources.sh +++ b/tools/find_sources.sh @@ -1,7 +1,7 @@ #!/bin/sh #set -x -SRCDIR_TO_ANALYZE="build-openmp/runtime/openmp build-parsec/runtime/parsec build-quark/runtime/quark build-starpu build compute control coreblas example include runtime testing timing" +SRCDIR_TO_ANALYZE="build-openmp/runtime/openmp build-parsec/runtime/parsec build-quark/runtime/quark build-starpu build compute control coreblas example include runtime testing" echo $PWD rm -f filelist.txt diff --git a/tools/fix_doxygen_date.sh b/tools/fix_doxygen_date.sh index fc28e1bcb034ded6cdeed15606205cb7f1b5dff9..2b3a799a3393722f2c8d7272455588b65b1d8c1d 100755 --- a/tools/fix_doxygen_date.sh +++ b/tools/fix_doxygen_date.sh @@ -1,12 +1,12 @@ # # @file fix_doxygen_date.sh # -# @copyright 2019 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, +# @copyright 2019-2020 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, # Univ. Bordeaux. All rights reserved. # -# @version 0.9.2 +# @version 1.0.0 # @author Florent Pruvost -# @date 2019-03-13 +# @date 2020-03-03 # # This script fix the date doxygen markup. #